From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

TIMA / Net-Trackback-0.99 / lib / Net / Trackback / Client.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
—
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

              
# Copyright (c) 2003-4 Timothy Appnel
# http://www.timaoutloud.org/
# This code is released under the Artistic License.
#
# Net::Trackback::Client - a class for implementing Trackback client 
# functionality. 
# 
package Net::Trackback::Client;
use strict;
use Net::Trackback;
use Net::Trackback::Data;
use Net::Trackback::Message;
sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->{__timeout} = 15;
    $self;
}
sub discover {
    my $self = shift;
    my $url  = shift;
    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new;
    $ua->agent("Net::Trackback/$Net::Trackback::VERSION");
    $ua->parse_head(0);
    $ua->timeout($self->{__timeout});
    my $req = HTTP::Request->new( GET => $url );
    my $res = $ua->request($req);
    return Net::Trackback::Message->new( {
        code=>$res->code, message=>$res->message } )
            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;
}
sub send_ping {
    my $self = shift;
    my $ping = shift;
    require LWP::UserAgent;
    my $ua = LWP::UserAgent->new;
    $ua->agent("Net::Trackback/$Net::Trackback::VERSION");
    $ua->timeout($self->{__timeout});
    my $ping_url = $ping->ping_url or
        return Net::Trackback::Message->new( { code=>1, message=>'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');
        $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}; }
1;
__END__
=begin
=head1 NAME
Net::Trackback::Client - a class for implementing Trackback client 
functionality. 
=head1 SYNOPSIS
 use Net::Trackback::Client;
 my $client = Net::Trackback::Client->new();
 my $url ='http://www.foo.org/foo.html';
 my $data = $client->discover($url);
 if (Net::Trackback->is_message($data)) {
    print $data->to_xml;
 } else {
    require Net::Trackback::Ping;
    my $p = {
        ping_url=>'http://www.foo.org/cgi/mt-tb.cgi/40',
        url=>'http://www.timaoutloud.org/archives/000206.html',
        title=>'The Next Generation of TrackBack: A Proposal',
        description=>'I thought it would be helpful to draft some 
            suggestions for consideration for the next generation (NG) 
            of the interface.'
    };
 my $ping = Net::Trackback::Ping->new($p);
 my $msg = $client->send_ping($ping);
 print $msg->to_xml;
=head1 METHODS
=item Net::Trackback::Client->new
Constructor method. Returns a Trackback client instance.
=item $client->discover($url)
A method that fetches the resource and searches for Trackback ping
data. If the given resource can not be retreived, a 
L<Net::Trackback::Message> object is returned with the HTTP error
code and message. (A liberty this module takes from the Trackback 
specification.) Returns a reference to an array of 
L<Net::Trackback::Data>  objects. If the resource is retreived 
and nothing was found returns C<undef>.
=item $client->send_ping($ping)
Executes a ping according to the L<Net::Trackback::Ping> object 
passed in and returns a L<Net::Trackback::Message> object with the 
results,
=item $client->timeout([$seconds])
An accessor to the LWP agent timeout in seconds. Default is 15 
seconds. If an optional parameter is passed in the value is set.
=head1 AUTHOR & COPYRIGHT
Please see the Net::Trackback manpage for author, copyright, and 
license information.
=cut
=end