File Coverage

blib/lib/Net/PubSubHubbub/Publisher.pm

Criterion	Covered	Total	%
statement	12	37	32.4
branch	0	14	0.0
condition			n/a
subroutine	4	7	57.1
pod	3	3	100.0
total	19	61	31.1

package Net::PubSubHubbub::Publisher;
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use Carp qw(croak);

=head1 NAME

Net::PubSubHubbub::Publisher - client library to ping a PubSubHubbub hub

=head1 OVERVIEW

  my $pub = Net::PubSubHubbub::Publisher->new(hub => $hub);
  $pub->publish_update($atom_topic_url) or
      die "Ping failed: " . $pub->last_response->status_line;

=cut

our $VERSION = "0.91";

=head1 CONSTRUCTOR

=over 4

=item C(hub => $hub[, ua => $ua])

Takes a required hub URL, and an optional L instance.

=back

=cut

sub new {
    my ($class, %opts) = @_;
    my $ua = delete $opts{ua};
    my $hub = delete $opts{hub};
    unless ($hub) {
        croak("Required option 'hub' not set.");
    }
    unless ($hub =~ m!^https?://!) {
        croak("Bogus hub URL of $hub");
    }
    if (%opts) {
        die "Unknown options: " . join(", ", sort keys %opts);
    }
    unless ($ua) {
        $ua = LWP::UserAgent->new(
                                  keep_alive => 1,
                                  agent => "Net-PubSubHubbub-Publisher-perl/$VERSION",
                                  );
    }
    return bless {
        ua => $ua,
        hub => $hub,
    }, $class;
}

=head1 METHODS

=over 4

=item C($topic_url)

=item C(@topic_urls)

Sends a ping that the provided Topic URL(s) has/have been updated.

Returns true on success.  If false, see C to figure out
why it failed.

=cut

sub publish_update {
    my ($self, @urls) = @_;
    croak "No URL(s) provided" unless @urls;
    foreach my $url (@urls) {
        croak("Bogus URL: $url") unless $url =~ m!^https?://!;
    }
    my @args = ("hub.mode" => "publish");
    push @args, map { ("hub.url" => $_) } @urls;
    my $req = POST $self->{hub}, \@args;
    my $res = $self->{last_res} = $self->{ua}->request($req);
    return 1 if $res->is_success;
    return 0;
}

=item C()

Returns the last L.  Use this when C
fails to discover why it failed.

=cut

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

1;

=back

=head1 COPYRIGHT & LICENSE

This module is Copyright (c) 2009 Brad Fitzpatrick.
All rights reserved.

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.

=head1 WARRANTY

This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.

=head1 AUTHOR

Brad Fitzpatrick

=head1 SEE ALSO

L -- PubSubHubbub home

=cut