# Copyright 2001, 2002 Benjamin Trott. This code cannot be redistributed without
# permission from www.movabletype.org.
#
# $Id: XMLRPC.pm,v 1.10 2002/08/01 19:49:44 btrott Exp $

package MT::XMLRPC;
use strict;

use MT;
use MT::ConfigMgr;
use MT::Util qw( encode_xml );
use MT::ErrorHandler;
@MT::XMLRPC::ISA = qw( MT::ErrorHandler );

sub weblogs_ping {
    my $class = shift;
    my($blog) = @_;
    my $url = MT::ConfigMgr->instance->WeblogsPingURL
        or return $class->error(MT->translate(
            "No WeblogsPingURL defined in mt.cfg" ));
    $class->ping_update('weblogUpdates.ping', $blog, $url);
}

sub mt_ping {
    my $class = shift;
    my($blog) = @_;
    my $url = MT::ConfigMgr->instance->MTPingURL
        or return $class->error(MT->translate(
            "No MTPingURL defined in mt.cfg" ));
    if (!ref($blog)) {
        require MT::Blog;
        $blog = MT::Blog->load($blog);
    }
    $class->ping_update('mtUpdates.ping', $blog, $url, $blog->mt_update_key);
}

sub ping_update {
    my $class = shift;
    my($method, $blog, $url, $mt_key) = @_;
    if (!ref($blog)) {
        require MT::Blog;
        $blog = MT::Blog->load($blog);
    }
    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new;
    $ua->agent('MovableType/' . MT->VERSION);
    $ua->timeout(MT::ConfigMgr->instance->PingTimeout);
    my $req = HTTP::Request->new('POST', $url);
    $req->header('Content-Type' => 'text/xml');
    my $blog_name = encode_xml($blog->name);
    my $blog_url = encode_xml($blog->site_url);
    my $text = <<XML;
<?xml version="1.0"?>
<methodCall>
    <methodName>$method</methodName>
    <params>
    <param><value>$blog_name</value></param>
    <param><value>$blog_url</value></param>
XML
    if ($mt_key) {
        $text .= "    <param><value>$mt_key</value></param>\n";
    }
    $text .= <<XML;
    </params>
</methodCall>
XML
    $req->content($text);
    my $res = $ua->request($req);
    if (substr($res->code, 0, 1) ne '2') {
        return $class->error(MT->translate(
            "HTTP error: [_1]", $res->status_line ));
    }
    my $content = $res->content;
    my($error, $msg) = $content =~
        m!flerror.*?<boolean>(\d+).*message.*?<value>(.+?)</value>!s;
    if ($error) {
        return $class->error(MT->translate(
            "Ping error: [_1]", $msg ));
    }
    $msg;
}

1;
__END__

=head1 NAME

MT::XMLRPC - Movable Type XML-RPC client routines

=head1 SYNOPSIS

    use MT::XMLRPC;

    ## Ping weblogs.com.
    MT::XMLRPC->weblogs_ping($blog)
        or die MT::XMLRPC->errstr;

    ## Ping a different service supporting the weblogs.com interface.
    MT::XMLRPC->ping_update('weblogUpdates.ping', $blog,
        'http://my.ping-service.com/RPC')
        or die MT::XMLRPC->errstr;

=head1 DESCRIPTION

I<MT::XMLRPC> provides XML-RPC client functionality for sending pings to
"recently updated" services. It contains built-in methods for sending pings
to I<weblogs.com> and I<movabletype.org>; in addition, it has a more
generic method for sending XML-RPC pings to other services that support the
general weblogs.com API.

=head1 USAGE

=head2 MT::XMLRPC->weblogs_ping($blog)

Send an XML-RPC ping to I<weblogs.com> for the blog I<$blog>, which should be
an I<MT::Blog> object.

On success, returns a true value; on failure, returns C<undef>, and the error
message can be obtained by calling I<errstr> on the class name.

=head2 MT::XMLRPC->mt_ping($blog)

Send an XML-RPC ping to I<movabletype.org> for the blog I<$blog>, which should
be an I<MT::Blog> object, and which should contain a valid Movable Type
Recently Updated Key.

On success, returns a true value; on failure, returns C<undef>, and the error
message can be obtained by calling I<errstr> on the class name.

=head2 MT::XMLRPC->ping_update($method, $blog, $url)

Send an XML-RPC ping to the XML-RPC server at I<$url> for the blog I<$blog>;
the XML-RPC method called will be I<$method>. In most cases (that is, unless
you know otherwise), you should just use C<weblogUpdates.ping> for I<$method>.

On success, returns a true value; on failure, returns C<undef>, and the error
message can be obtained by calling I<errstr> on the class name.

=head1 AUTHOR & COPYRIGHTS

Please see the I<MT> manpage for author, copyright, and license information.

=cut