#!/usr/bin/perl

# Based on: 
# weblogUpdatesPing
# version: 1.0
# date:    2001.11.12
# author:  Hans Kellner
# website: http://www.hanskellner.com/
#
#
# A Perl subroutine that pings the "blogshares.com/rpc.php" server with 
# a specified weblog name and url.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

use IO::Socket qw(:DEFAULT :crlf);
use HTTP::Request;
use LWP::UserAgent;

my $in;

  if ($ENV{'REQUEST_METHOD'} eq "GET") {
         $in = $ENV{'QUERY_STRING'};
  } else {
         $in = <STDIN>;
  }

$in =~ s/%(..)/pack("c",hex($1))/ge;
$in =~ s/\+/ /g;

my @input;
@input = split(/&/, $in);

my %processed_input;
my $slot;
my @temp;

foreach $slot (@input) {
    @temp = split (/=/, $slot);
    $processed_input{$temp[0]} = $temp[1];
}

$weblog_name = $processed_input{'weblog_name'};
$weblog_url  = $processed_input{'weblog_url'};

#
# Pings the blogshares.com server with a Weblog name and url.
# See the specification at "http://www.xmlrpc.com/weblogsCom".
#
# usage: weblogUpdatesPing( name, url );
#           name    A string containing a descriptive name of your weblog.
#           url     A url to your weblog.
#
# returns: A string formatted "(retcode) : message".
#           retcode A return code; 0 if success, otherwise not 0.
#           message A string message describing success or failure.
#

sub weblogUpdatesPing($$)
{
    my $name = shift;
    my $url  = shift;

    if ( !$name || !$url ) {
        return "(-1) : Invalid weblog name or url.  Please set both.";
    }

    my $msg = "(-1) : Unknown error.";   # holds our return value

    # This is the xml-rpc request
    my $pingStr =
        "<?xml version=\"1.0\"?>" .
        "<methodCall>" .
        "    <methodName>weblogUpdates.ping</methodName>" .
        "    <params>" .
        "        <param><value>$name</value></param>" .
        "        <param><value>$url</value></param>" .
        "    </params>" .
            "</methodCall>";

    # Connect to the server
    my $ua = LWP::UserAgent->new;
    my $req = HTTP::Request->new('POST', 'http://www.blogshares.com/rpc.php');
    $req->header('Content-Type' => 'text/xml');
    $req->content($pingStr);
    my $response = $ua->request($req);

    $retCode = $response->code;
    $retCode =~ s/.*<boolean>//si;
    $retCode =~ s/<\/boolean>.*//si;

    $retMsg = $response->content;

    $retMsg =~ s/.*<\/boolean>//si;
    $retMsg =~ s/.*<value>//si;
    $retMsg =~ s/<\/value>.*//si;

    $msg = "($retCode): $retMsg";

    return $msg;
}

# Ping the server.
print "\nPinging www.blogshares.com/rpc.php for weblog \"$weblog_name\" at 
\"$weblog_url\"\n\n";
$pong = weblogUpdatesPing( $weblog_name, $weblog_url );
print "$pong\n\n";