File Coverage

blib/lib/Wiki/Toolkit/Plugin/Ping.pm

Criterion	Covered	Total	%
statement	39	71	54.9
branch	8	18	44.4
condition	1	3	33.3
subroutine	7	10	70.0
pod	2	4	50.0
total	57	106	53.7

package Wiki::Toolkit::Plugin::Ping;

use strict;
use warnings;

use vars qw( @ISA $VERSION );

use Wiki::Toolkit::Plugin;
use LWP;
use LWP::UserAgent;

@ISA = qw( Wiki::Toolkit::Plugin );
$VERSION = '0.03';


# Set things up
sub new {
    my $class = shift;
    my %args = @_;

    my $self = {};
    bless $self, $class;

    # Get list of services
    unless($args{services}) {
        $self->{services} = {};
        return $self;
    }
    my %services = %{$args{services}};

    # Get node -> URL mapping
    unless($args{node_to_url}) {
        die("Must supply 'node_to_url;");
    }
    unless($args{node_to_url} =~ /\$node/) {
        die("node_to_url '$args{node_to_url}' must contain \$node");
    }
    $self->{node_to_url} = $args{node_to_url};
    $self->{agent} = $args{agent} || "Wiki::Toolkit::Plugin::Ping $VERSION";


    # Check the services
    foreach my $service (keys %services) {
        my $url = $services{$service};

        # Make valid
        unless($url =~ /^http:\/\//) {
            $url = "http://".$url;
            $services{$service} = $url;
        }
        unless($url =~ /\$url/) {
            die("For $service, URL '$url' didn't contain \$url anywhere\n");
        }
    }

    # Save
    $self->{services} = \%services;

    # Done setup
    return $self;
}

# Return our list of services, in case anyone's interested
sub services {
    my $self = shift;
    return %{$self->{services}};
}

# Define our post_write plugin, which does the ping
# Happens in another thread, to stop it slowing things down
sub post_write {
    my $self = shift;
    unless(keys %{$self->{services}}) { return; }

    my %args = @_;
    my ($node,$node_id,$version,$content,$metadata) =
        @args{ qw( node node_id version content metadata ) };

    # Spawn a new thread
    my $pid = fork();
    if($pid) {
        # We're the main thread, return now
        return;
    } else {
        # We're the child, do the work

        # Apply the formatter escaping on the node name, if there's one
        if($self->formatter) {
            # Eval, in case the formatter doesn't support node name escaping
            eval {
                $node = $self->formatter->node_name_to_node_param($node);
            };
        }

        # What's the URL of the node?
        my $node_url = $self->{node_to_url};
        $node_url =~ s/\$node/$node/;

        # Get a LWP instance
        my $ua = LWP::UserAgent->new;
        $ua->agent($self->{agent});

        # Ping each service
        foreach my $service (keys %{$self->{services}}) {
            # Build the ping URL
            my $ping_url = $self->{services}->{$service};
            $ping_url =~ s/\$url/$node_url/;

            # Ping
            my $req = HTTP::Request->new(GET => $ping_url);
            my $res = $ua->request($req);
            unless($res->is_success) {
                warn("Error pinging $service: $res->status_line");
            }
        }

        # All done, close the thread
        exit;
    }
}

# Returns a list of well known services
sub well_known {
    return (
            pingerati => 'http://pingerati.net/ping/$url',
            geourl    => 'http://geourl.org/ping/?p=$url',
    );
}

1;
__END__