# Copyright 2001-2005 Six Apart.# SCRiPTMAFiA 2005 - THE DiRTY HANDS ON YOUR SCRiPTS## $Id: XMLRPC.pm 10197 2005-03-09 00:27:57Z ezra $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);    }    my $ua = MT->new_ua;    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) = $content =~ m!flerror.*?<boolean>(\d+)!s;    my($msg) = $content =~ m!message.*?<value>(.+?)</value>!s;    if ($error) {        return $class->error(MT->translate(            "Ping error: [_1]", $msg ));    }    $msg;}1;__END__=head1 NAMEMT::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 DESCRIPTIONI<MT::XMLRPC> provides XML-RPC client functionality for sending pings to"recently updated" services. It contains built-in methods for sending pingsto I<weblogs.com> and I; in addition, it has a moregeneric method for sending XML-RPC pings to other services that support thegeneral 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 bean I<MT::Blog> object.On success, returns a true value; on failure, returns C<undef>, and the errormessage can be obtained by calling I<errstr> on the class name.=head2 MT::XMLRPC->mt_ping($blog)Send an XML-RPC ping to I for the blog I<$blog>, which shouldbe an I<MT::Blog> object, and which should contain a valid Movable TypeRecently Updated Key.On success, returns a true value; on failure, returns C<undef>, and the errormessage 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, unlessyou 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 errormessage can be obtained by calling I<errstr> on the class name.=head1 AUTHOR & COPYRIGHTSPlease see the I<MT> manpage for author, copyright, and license information.=cut