1# Copyright (c) 2003-2004 Timothy Appnel (cpan@timaoutloud.org)
2# http://www.timaoutloud.org/
3# This code is released under the Artistic License.
4package Net::Trackback::Client;
5use strict;
6use base qw( Class::ErrorHandler );
7
8use Net::Trackback;
9use Net::Trackback::Data;
10use Net::Trackback::Message;
11
12sub new {
13    my $class = shift;
14    my $self = bless {}, $class;
15    $self->{__timeout} = 15;
16    $self->{__no_proxy} = [ qw(localhost, 127.0.0.1) ];
17    $self->{__charset} = 'utf-8';
18    $self;
19}
20
21sub init_agent {
22    my $self = shift;
23    require LWP::UserAgent;
24    my $agent = LWP::UserAgent->new;
25    $agent->agent("Net::Trackback/$Net::Trackback::VERSION");
26    # $agent->parse_head(0);
27    $agent->protocols_allowed( [ qw(http https) ] );
28    $agent->proxy([qw(http https)], $self->{__proxy}) if $self->{__proxy};
29    $agent->no_proxy(@{$self->{__no_proxy}}) if $self->{__no_proxy};
30    $agent->timeout($self->{__timeout});
31    $agent;
32}
33
34sub discover {
35    my($self,$url) = @_;
36    my $agent = $self->init_agent;
37    my $req = HTTP::Request->new( GET => $url );
38    my $res = $agent->request($req);
39    return self->error($url.' '.$res->status_line)
40        unless $res->is_success;
41    my $c = $res->content;
42    my @data;
43    # Theoretically this is bad namespace form and eventually should
44    # be fixed. If you stick to the standard prefixes you're fine.
45    while ( $c =~ m!(<rdf:RDF.*?</rdf:RDF>)!sg ) {
46        if (my $tb = Net::Trackback::Data->parse($url,$1)) {
47            push( @data, $tb );
48        }
49    }
50    @data ? \@data : $self->error('Nothing to discover.')
51}
52
53sub send_ping {
54    my($self,$ping) = @_;
55    my $ua = $self->init_agent;
56    my $ping_url = $ping->ping_url or
57        return $self->error('No ping URL');
58    my $req;
59    $ping->timestamp(time);
60    if ( $ping_url =~ /\?/ ) {
61        $req = HTTP::Request->new( GET=>join('&', $ping_url, $ping->to_urlencoded) );
62    } else {
63        $req = HTTP::Request->new( POST => $ping_url );
64        $req->content_type('application/x-www-form-urlencoded; charset='
65            .$self->{__charset});
66        $req->content( $ping->to_urlencoded );
67    }
68    my $res = $ua->request($req);
69    return Net::Trackback::Message->new( {
70        code=>$res->code, message=>$res->message } )
71            unless $res->is_success;
72    Net::Trackback::Message->parse( $res->content );
73}
74
75sub timeout { $_[0]->{__timeout} = $_[1] if $_[1]; $_[0]->{__timeout}; }
76sub proxy { $_[0]->{__proxy} = $_[1] if $_[1]; $_[0]->{__proxy}; }
77sub no_proxy { $_[0]->{__no_proxy} = $_[1] if $_[1]; $_[0]->{__no_proxy}; }
78sub charset { $_[0]->{__charset} = $_[1] if $_[1]; $_[0]->{__charset}; }
79
801;
81
82__END__
83
84=begin
85
86=head1 NAME
87
88Net::Trackback::Client - a class for implementing Trackback client
89functionality.
90
91=head1 SYNOPSIS
92
93 use Net::Trackback::Client;
94 my $client = Net::Trackback::Client->new();
95 my $url ='http://www.foo.org/foo.html';
96 my $data = $client->discover($url);
97 if (Net::Trackback->is_message($data)) {
98    print $data->to_xml;
99 } else {
100    require Net::Trackback::Ping;
101    my $p = {
102        ping_url=>'http://www.foo.org/cgi/mt-tb.cgi/40',
103        url=>'http://www.timaoutloud.org/archives/000206.html',
104        title=>'The Next Generation of TrackBack: A Proposal',
105        description=>'I thought it would be helpful to draft some
106            suggestions for consideration for the next generation (NG)
107            of the interface.'
108    };
109 my $ping = Net::Trackback::Ping->new($p);
110 my $msg = $client->send_ping($ping);
111 print $msg->to_xml;
112
113=head1 METHODS
114
115=item Net::Trackback::Client->new
116
117Constructor method. Returns a Trackback client instance.
118
119=item $client->discover($url)
120
121A method that fetches the resource and searches for Trackback ping
122data. If the given resource can not be retreived or Trackback data
123was not found, C<undef> is returned. Use the C<errstr> method to
124get the HTTP status code and message. If successful, returns a
125reference to an array of L<Net::Trackback::Data> objects.
126
127=item $client->send_ping($ping)
128
129Executes a ping according to the L<Net::Trackback::Ping> object
130passed in and returns a L<Net::Trackback::Message> object with the
131results,
132
133=item $client->timeout([$seconds])
134
135An accessor to the LWP agent timeout in seconds. Default is 15
136seconds. If an optional parameter is passed in the value is set.
137
138=item $client->proxy($proxy)
139
140The URI of the proxy server to route all requests through. The default
141is C<undef> -- no proxy.
142
143=item $client->no_proxy([\@noproxy])
144
145An ARRAY reference of domains to B<not> request through the proxy.
146If an optional parameter is passed in the value is set. The default
147list includes I<localhost> and I<127.0.0.1>.
148
149=item $client->charset([$charset])
150
151The charset header parameter to use when sending pings. If an
152optional parameter is passed in the value is set. The default is
153'utf-8'.
154
155=head2 Errors
156
157This module is a subclass of L<Class::ErrorHandler> and inherits
158two methods for passing error message back to a caller.
159
160=item Class->error($message)
161
162=item $object->error($message)
163
164Sets the error message for either the class Class or the object
165$object to the message $message. Returns undef.
166
167=item Class->errstr
168
169=item $object->errstr
170
171Accesses the last error message set in the class Class or the
172object $object, respectively, and returns that error message.
173
174=head1 AUTHOR & COPYRIGHT
175
176Please see the Net::Trackback manpage for author, copyright, and
177license information.
178
179=cut
180
181=end