#!/usr/bin/perl -w
use strict;
use Jcode;
use XMLRPC::Lite;
my $site_uri = 'http://sugaken.net/note/';
my $site_name = 'Sugaken\'s Web Page[note]';
# my $site_rss = 'http://sugaken.net/note/rss/';
print "Content-Type: text/html; charset=EUC-JP\n\n";
print "Ping Completed\n";
print "Ping Completed
\n";
# Ping Server => XML-RPC Interface URI
my %ping_server_uri = (
'ping.bloggers.jp' => 'http://ping.bloggers.jp/rpc/',
'Myblog_japan' => 'http://ping.myblog.jp/',
'BlogPeople' => 'http://www.blogpeople.net/servlet/weblogUpdates',
'Bulkfeeds' => 'http://bulkfeeds.net/rpc',
'cocolog' => 'http://ping.cocolog-nifty.com/xmlrpc',
'goo BLOG' => 'http://blog.goo.ne.jp/XMLRPC',
'blogdb' => 'http://blogdb.jp/xmlrpc',
'debug' => 'local',
'Pine' => 'http://www.trackbackcenter.com/cgi-bin/receive.cgi' ,
'pine2' => 'http://www.trackbackcenter.com/cgi-bin/i/102' ,
);
# Select servers to send update ping
my @ping_servers = ('ping.bloggers.jp','Myblog_japan','BlogPeople','Bulkfeeds','cocolog','goo BLOG', 'blogdb', 'Pine', 'pine2');
my %mtime;
my $all_results = '';
#if (&check_mtime()) {
foreach my $ping_server_name (@ping_servers) {
my $result = &send_ping(
rpc => $ping_server_uri{$ping_server_name},
blog_name => Jcode::convert($site_name, 'utf8', 'euc'),
blog_url => $site_uri,
# blog_rss => $site_rss,
);
$all_results .= &as_string($result);
}
#} else {
# $all_results = "Aborted ping.";
#}
print scalar localtime(time()), qq(
\n);
print qq(Ping: @ping_servers
$all_results);
# sub check_mtime {
# # 30 min. check
# return undef if ((time() - $mtime{'blog'}) > 1800);
# return undef if ((time() - $mtime{'lastping'}) < 1800);
# return 1;
# }
#&send_ping(rpc => $, blog_name => $, blog_url => $, blog_rss => $);
sub send_ping {
my %arg = @_;
my $rpc_uri = $arg{rpc};
my $blog_name = $arg{blog_name};
my $blog_url = $arg{blog_url};
# my $blog_rss = $arg{blog_rss};
if ($rpc_uri !~ /^http/) {
return {
filerror => 0,
message => 'local echo mode',
name => $blog_name,
uri => $blog_url,
# rss => $blog_rss,
}
}
# send ping
my $result = eval {
XMLRPC::Lite
->proxy($rpc_uri)
->call(
'weblogUpdates.ping',
$blog_name,
$blog_url,
# $blog_rss,
)
->result;
};
if ($@) {
return $@;
}
return $result;
}
sub as_string {
my $v = shift;
if (not ref $v) {
return $v;
} elsif (ref $v eq 'SCALAR') {
return $$v;
} elsif (ref $v eq 'ARRAY') {
return join("
\n", @$v);
} elsif (ref $v eq 'HASH') {
my $ret = '';
foreach (sort keys %$v) {
$ret .= "$_ => $v->{$_}
\n";
}
return $ret;
} else {
return undef;
}
}
print "
\n";
print "\n";
#print "$send_ping(result)";
print "
\n";
print "\n";