File Coverage

blib/lib/XMLRPC/Lite/UpdatePing.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package XMLRPC::Lite::UpdatePing;

use strict;
use vars qw($VERSION);
our $VERSION = '0.06';

use Encode;
use XMLRPC::Lite;

sub new {
    my $class = shift;
    bless { ping_servers => [
        'http://blogsearch.google.com/ping/RPC2',
        'http://www.blogpeople.net/servlet/weblogUpdates',
        'http://rpc.technorati.com/rpc/ping',
    ], }, $class;
}

sub ping_servers {
    my $self = shift;
    return $self->{ping_servers};
}

sub add_ping_server {
    my $self = shift;
    my $new_ping_server = shift;
    push @{$self->{ping_servers}}, $new_ping_server;
    return $self;
}

sub setup_ping_servers {
    my $self = shift;
    $self->{ping_servers} = shift;
    return $self;
}

sub ping {
    my $self = shift;
    my $feed_uris = shift;
    my ($all_res, $recent_res) = ('', '');
    for my $feed_name ( keys %{$feed_uris} ) {
        for my $ping_server_uri (@{$self->ping_servers}) {
            $recent_res = &_send_ping(
                rpc       => $ping_server_uri,
                site_name => encode('eucjp', $feed_name),
                feed_uri  => $$feed_uris{$feed_name},
            );
            $all_res .= &_as_string($recent_res) if defined $recent_res;
        }
    }
    return $all_res;
}

sub _send_ping {
    my %arg = @_;
    my $rpc_uri   = $arg{rpc};
    my $site_name = $arg{site_name};
    my $feed_uri  = $arg{feed_uri};

    if ( ! defined $rpc_uri || $rpc_uri !~ m/^http/ ) {
        return { flerror => 0,
                 message => 'local echo mode',
                 name    => $site_name,
                 uri     => $feed_uri,   };
    }

    my $result = eval {
        XMLRPC::Lite->proxy($rpc_uri)
            ->call( 'weblogUpdates.ping', $site_name, $feed_uri, )
            ->result ;
    };
    return $@ if $@;

    return (defined $result) ? $result : { 'flerror' => 'none', 'message' => 'none' };
}

sub _as_string {
    my $input = shift;
    if (not ref $input) {
        return $input;
    } elsif (ref $input eq 'SCALAR') {
        return $$input;
    } elsif (ref $input eq 'ARRAY') {
        return join("\n", @$input);
    } elsif (ref $input eq 'HASH') {
        my $return = '';
        for my $key (sort keys %$input) {
            $return .= "$key => $input->{$key}\n";
        }
        return $return;
    } else {
        return 'unknown data format';
    }
}

1;

__END__