Net::Trackback::Client - a class for implementing Trackback client

# Copyright (c) 2003-2004 Timothy Appnel (cpan@timaoutloud.org)
# http://www.timaoutloud.org/
# This code is released under the Artistic License.
package Net::Trackback::Client;
use strict;
use base qw( Class::ErrorHandler );

use Net::Trackback;
use Net::Trackback::Data;
use Net::Trackback::Message;

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->{__timeout} = 15;
    $self->{__no_proxy} = [ qw(localhost, 127.0.0.1) ];
    $self->{__charset} = 'utf-8';
    $self;
}

sub init_agent {
    my $self = shift;
    require LWP::UserAgent;
    my $agent = LWP::UserAgent->new;
    $agent->agent("Net::Trackback/$Net::Trackback::VERSION");
    # $agent->parse_head(0);
    $agent->protocols_allowed( [ qw(http https) ] );
    $agent->proxy([qw(http https)], $self->{__proxy}) if $self->{__proxy};
    $agent->no_proxy(@{$self->{__no_proxy}}) if $self->{__no_proxy};
    $agent->timeout($self->{__timeout});
    $agent;
}

sub discover {
    my($self,$url) = @_;
    my $agent = $self->init_agent;
    my $req = HTTP::Request->new( GET => $url );
    my $res = $agent->request($req);
    return self->error($url.' '.$res->status_line) 
        unless $res->is_success;
    my $c = $res->content;
    my @data;
    # Theoretically this is bad namespace form and eventually should 
    # be fixed. If you stick to the standard prefixes you're fine.
    while ( $c =~ m!(<rdf:RDF.*?</rdf:RDF>)!sg ) {
        if (my $tb = Net::Trackback::Data->parse($url,$1)) {
            push( @data, $tb ); 
        }
    }
    @data ? \@data : $self->error('Nothing to discover.')
}

sub send_ping {
    my($self,$ping) = @_;
    my $ua = $self->init_agent;
    my $ping_url = $ping->ping_url or
        return $self->error('No ping URL');
    my $req;
    $ping->timestamp(time);
    if ( $ping_url =~ /\?/ ) {
        $req = HTTP::Request->new( GET=>join('&', $ping_url, $ping->to_urlencoded) );
    } else {
        $req = HTTP::Request->new( POST => $ping_url );
        $req->content_type('application/x-www-form-urlencoded; charset='
            .$self->{__charset});
        $req->content( $ping->to_urlencoded );
    }
    my $res = $ua->request($req);
    return Net::Trackback::Message->new( {
        code=>$res->code, message=>$res->message } )
            unless $res->is_success;
    Net::Trackback::Message->parse( $res->content );
}

sub timeout { $_[0]->{__timeout} = $_[1] if $_[1]; $_[0]->{__timeout}; }
sub proxy { $_[0]->{__proxy} = $_[1] if $_[1]; $_[0]->{__proxy}; }
sub no_proxy { $_[0]->{__no_proxy} = $_[1] if $_[1]; $_[0]->{__no_proxy}; }
sub charset { $_[0]->{__charset} = $_[1] if $_[1]; $_[0]->{__charset}; }

1;

__END__