File: XMLRPC.pm

package info (click to toggle)
movabletype-opensource 5.1.4%2Bdfsg-4%2Bdeb7u3
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 32,996 kB
  • sloc: perl: 197,285; php: 62,405; sh: 166; xml: 117; makefile: 83; sql: 32
file content (145 lines) | stat: -rw-r--r-- 4,443 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
# Movable Type (r) Open Source (C) 2001-2012 Six Apart, Ltd.
# This program is distributed under the terms of the
# GNU General Public License, version 2.
#
# $Id$

package MT::XMLRPC;
use strict;

use MT;
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->config->WeblogsPingURL
        or return $class->error(
        MT->translate("No WeblogsPingURL defined in the configuration file")
        );
    $class->ping_update( 'weblogUpdates.ping', $blog, $url );
}

sub mt_ping {
    my $class  = shift;
    my ($blog) = @_;
    my $url    = MT->config->MTPingURL
        or return $class->error(
        MT->translate("No MTPingURL defined in the configuration file") );
    if ( !ref($blog) ) {
        require MT::Blog;
        $blog = MT::Blog->load($blog)
            or return $class->error(
            MT->translate( 'Can\'t load blog #[_1].', $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)
            or return $class->error(
            MT->translate( 'Can\'t load blog #[_1].', $blog ) );
    }
    my $ua = MT->new_ua( { timeout => MT->config->PingTimeout } );
    my $req = HTTP::Request->new( 'POST', $url );
    $req->header( 'Content-Type' => 'text/xml' );
    my $blog_name = encode_xml( Encode::encode_utf8( $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 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