Replace atomfeed $feed_url with $path_info_full, for correct self links.
[matthijs/upstream/blosxom-plugins.git] / general / autotrack
1 # Blosxom Plugin: autotrack                                       -*- cperl -*-
2 # Author: Todd Larason (jtl@molehill.org)
3 # Version: 0+2i
4 # Blosxom Home/Docs/Licensing: http://blosxom.sourceforge.net/
5 # AutoTrack plugin Home/Docs/Licensing:
6 #   http://molelog.molehill.org/blox/Computers/Internet/Web/Blosxom/AutoTrack/
7 package autotrack;
8
9 # -------------- Configuration Variables --------------
10
11 # regular expression matching URLs not to trackback
12 # there's no reason to try google or amazon, and most people don't
13 # want to trackback their own stories
14 $dont_tb_re = qr!(?:http://(?:
15                          (?: www\.google\.com ) |
16                          (?: www\.amazon\.com )
17                         )
18                   ) |
19                   (?: $blosxom::url )!ix
20   unless defined $dont_tb_re;
21
22 # what to do if the timestamp file doesn't exist?  if $start_from_now is
23 # set, autotrack future stories but not old ones
24 $start_from_now = 1 unless defined $start_from_now;
25
26 # how automatic?  if $semi_auto is set, only send trackbacks if ?autotrack=yes
27 # otheriwse, fully automatic
28 $semi_auto = 1 unless defined $semi_auto;
29
30 # networking implementation to be used
31 #   can be 'LWP', 'curl' or 'wget' (or a full pathname to a curl or wget
32 #   executable)
33 #   wget must be at least a 1.9 beta to support the --post-data option
34 $networking = "LWP" unless defined $networking;
35
36 $debug_level = 1
37   unless defined $debug_level;
38
39 # -----------------------------------------------------
40 \f
41 # template-visible vars
42 \f
43 use CGI qw/param/;
44 use HTML::Entities;
45 use File::stat;
46 use strict;
47 use vars qw/$dont_tb_re $start_from_now $semi_auto $networking $debug_level/;
48 \f
49 my $dont_really_ping = 0;
50 my $package        = "autotrack";
51 my $timestamp_file = "$blosxom::plugin_state_dir/.$package.timestamp";
52 my $last_timestamp;
53 my $files;
54 \f
55 sub debug {
56     my ($level, @msg) = @_;
57
58     if ($debug_level >= $level) {
59         print STDERR "$package debug $level: @msg\n";
60     }
61 }
62 \f
63 # utility funcs
64 sub url_escape {
65     local ($_) = @_;
66
67     s/([^a-zA-Z0-9])/sprintf("%%%02x",ord($1))/eg;
68     s/%20/+/g;
69     return $_;
70 }
71 \f
72 sub GET {
73     my ($url) = @_;
74
75     if ($networking =~ m:curl:) {
76         return `$networking -m 30 -s $url`;
77     } elsif ($networking =~ m:wget:) {
78         return `$networking --quiet -O - $url`;
79     } elsif ($networking eq 'LWP') {
80         foreach (qw/LWP::UserAgent HTTP::Request::Common/) {
81             eval "require $_";
82             if ($@) {
83                 debug(0, "Can't load $_, can't use LWP networking");
84                 return undef;
85             }
86         }
87         my $ua  = LWP::UserAgent->new;
88         my $res = $ua->request(HTTP::Request::Common::GET $url);
89         if (!$res->is_success) {
90             my $error = $res->status_line;
91             debug(0, "HTTP GET error: $error");
92             return undef;
93         }
94         return $res->content;
95     } else {
96         debug(0, "ERROR: invalid \$networking $networking");
97     }
98 }
99
100 sub POST {
101     my ($url, %vars) = @_;
102
103     if ($networking =~ m:curl:) {
104         my $command = "$networking -m 30 -s ";
105         $command .= join ' ',
106           map {my $v = url_escape($vars{$_}); "-d $_=$v";} keys %vars;
107         $command .= " $url";
108         debug(2, "Posting with :$command:");
109         return `$command`
110           unless $dont_really_ping;
111         return "<error>0</error>";  # for testing
112     } elsif ($networking =~ m:wget:) {
113         my $command = "$networking --quiet -O - --post-data='";
114         $command .= join '&',
115           map {my $v = url_escape($vars{$_}); "$_=$v"} keys %vars;
116         $command .= "' $url";
117         debug(2, "Posting with :$command:");
118         return `$command`
119           unless $dont_really_ping;
120         return "<error>0</error>";  # for testing
121     } elsif ($networking eq 'LWP') {
122         foreach (qw/LWP::UserAgent HTTP::Request::Common/) {
123             eval "require $_";
124             if ($@) {
125                 debug(0, "Can't load $_, can't use LWP networking");
126                 return undef;
127             }
128         }
129         my $ua  = LWP::UserAgent->new;
130         my $res = $ua->request(HTTP::Request::Common::POST($url, [%vars]));
131         if (!$res->is_success) {
132             my $error = $res->status_line;
133             debug(0, "HTTP POST error: $error");
134             return undef;
135         }
136         return $res->content;
137     } else {
138         debug(0, "ERROR: invalid \$networking $networking");
139     }
140 }
141 \f
142 sub get_trackback_url {
143     my ($url) = @_;
144
145     return undef if ($url =~ m:$dont_tb_re:);
146     my $text = GET($url);
147     return undef if (!defined($text));
148
149     while ($text =~ m!(<rdf:RDF.*?</rdf:RDF>)!msg) {
150         my $rdf = $1;
151         my ($id) = ($rdf =~ m!dc:identifier="([^\"]+)"!);
152         next unless ($id eq $url);
153         my ($tb) = ($rdf =~ m!trackback:ping="([^\"]+)"!);
154         return $tb if defined $tb;
155     }
156     if ($url =~ m:(.*)\#:) {
157         $url = $1;
158         while ($text =~ m!(<rdf:RDF.*?</rdf:RDF>)!msg) {
159             my $rdf = $1;
160             # XXX is this good enough?  Can't the namespace IDs be different?
161             # the sample code in the spec @
162             # http://www.movabletype.org/docs/mttrackback.html
163             # does it this way
164             my ($id) = ($rdf =~ m!dc:identifier="([^\"]+)"!);
165             next unless ($id eq $url);
166             my ($tb) = ($rdf =~ m!trackback:ping="([^\"]+)"!);
167             return $tb if defined $tb;
168         }
169     }
170     debug(2, "Couldn't find tb url for $url");
171     return undef;
172 }
173
174 sub ping_trackback {
175     my ($tb_url, $title, $excerpt, $url) = @_;
176
177     my $txt = POST($tb_url, title => $title, url => $url, excerpt => $excerpt,
178                    blog_name => $blosxom::blog_title);
179     debug(3, "Response:$txt:");
180     if ($txt =~ m:<error>(.*?)</error>:ms) {
181         if ($1) {
182             my $errcode = $1;
183             $txt =~ m:<message>(.*)</message>:ms;
184             debug(0, "Error $errcode ($1) pinging $tb_url");
185             return 0;
186         }
187         return 1;
188     }
189     debug(0, "Malformed response while pinging $tb_url");
190     return 1;
191 }
192
193 sub make_excerpt {
194     my ($story) = @_;
195
196     # XXX options to use plaintext or foreshortened plugins
197
198     $story =~ s:<.+?>::msg;
199     $story = substr($story, 0, 255);
200
201     return $story;
202 }
203 \f
204 # plugin funcs
205 sub start {
206     return 0 unless $networking;
207     return 0 if ($semi_auto && !param('autotrack'));
208     # XXX there are at least two different race conditions here
209     # 1: two instances running at the same time could both see an old
210     #    timestamp
211     # 2: an instance run at the same time a new story is published could
212     #    (at least if there's any clock skew at all) create a timestamp
213     #    file >= timestamp(story), for a story that isn't seen.
214     $last_timestamp = -e $timestamp_file ? stat($timestamp_file)->mtime :
215       ($start_from_now ? time : 0);
216     my $fh = new FileHandle;
217     if (!$fh->open("> $timestamp_file")) {
218         debug(0, "Couldn't touch timestamp file $timestamp_file");
219         return 0;
220     }
221     $fh->close;
222
223     debug(1, "autotrack enabled");
224
225     return 1;
226 }
227
228 sub filter {
229     my ($pkg, $files_ref) = @_;
230
231     $files = $files_ref;
232
233     return 1;
234 }
235
236 sub story {
237     my ($pkg, $path, $filename, $story_ref, $title_ref, $body_ref) = @_;
238     my ($pathname) = "$blosxom::datadir$path/$filename.$blosxom::file_extension";
239     return 1 if ($files->{$pathname} < $last_timestamp);
240     my (%pinged, $ping_tries, $ping_succeed);
241     my $excerpt = make_excerpt($$body_ref);
242     my $url     = "$blosxom::url$path/$filename.writeback";
243     defined $meta::tb_ping and
244       ++$ping_tries and
245         ping_trackback($meta::tb_ping, $$title_ref, $excerpt, $url) and
246           ++$ping_succeed and
247             ++$pinged{$meta::tb_ping};
248     return 1 if (defined $meta::autotrack && $meta::autotrack eq 'no');
249     while ($$body_ref =~
250            m!<a\s [^>]*
251              href=(?:
252                    (http://[^ ]+) |
253                    "(http://[^\"]+)"
254                   )!msxg) {
255         my $trackback_url = get_trackback_url(decode_entities($+));
256         next unless defined $trackback_url;
257         next if $pinged{$trackback_url};
258         $ping_tries++;
259         ping_trackback($trackback_url, $$title_ref, $excerpt, $url) and
260           ++$ping_succeed and
261             ++$pinged{trackback_url};
262         debug(1, "autotracked: $trackback_url");
263     }
264
265     # XXX what do we do if some succeed and some fail?
266     # If we tried some but they all failed, revert the timestamp to
267     # try again later
268     if ($ping_succeed == 0 && $ping_tries > 0) {
269         debug(0, "All pings failed, reverting timestamp");
270         utime($last_timestamp, $last_timestamp, $timestamp_file);
271     }
272
273     1;
274 }
275 1;
276 =head1 NAME
277
278 Blosxom Plug-in: autotrack
279
280 =head1 SYNOPSIS
281
282 Automatically or semi-automatically sends trackback pings for new stories.
283
284 =head1 VERSION
285
286 0+2i
287
288 2nd test release
289
290 =head1 AUTHOR
291
292 Todd Larason <jtl@molehill.org> http://molelog.molehill.org/
293
294 This plugin is now maintained by the Blosxom Sourceforge Team,
295 <blosxom-devel@lists.sourceforge.net>.
296
297 =head1 BUGS
298
299 None known; please send bug reports and feedback to the Blosxom
300 development mailing list <blosxom-devel@lists.sourceforge.net>.
301
302 =head1 Trackback Ping URL Discovery
303
304 Trackback Ping URLs are discovered two different ways.
305
306 =head2 Manual Ping URLs
307
308 If you have the meta plugin installed, and have it set to run prior to the
309 autotrack plugin, you can give a trackback url with the "meta-tb_ping"
310 header; the value of the header should be the ping URL to ping.
311
312 =head2 Automatic Ping URL detection
313
314 Subject to some exceptions explained below, every URL given in an 'href' in
315 the story is fetched, and the resulting content is searched for embedded RDF
316 sections giving trackback URLs for the given URL.  This is the preferred way
317 for all tools to be given trackback URLs, as it requires no human
318 intervention, but unfortunately not everyone which has a trackback server
319 includes the appropriate RDF.  Even more unfortunately, there's no easy
320 way to know whether it's included or not, other than examining the source
321 of the page.
322
323 It's always safe to give a meta-tb_ping header; if you give one, and the
324 same ping URL is found by autodiscovery, it's only pinged once.
325
326 If you don't want autodiscovery to be used for a given story, you can set
327 the meta header 'meta-autotrack' to 'no'.  If "meta-autotrack: no" is given,
328 the meta-tb_ping URL is still pinged if it's specified.
329
330 =head1 Customization
331
332 =head2 Configuration Variables
333
334 C<$dont_tb_re> is a regular expression agains which URLs are matched;
335 if it matches, the URL isn't fetched for autodiscovery; this is useful
336 for classes of URLs that you link to frequently that you know don't
337 include the autodiscovery RDF, or that you don't wish to be pinged.  The
338 default value matches Amazon and Google URLs, as well as references to
339 the current weblog.
340
341 C<$start_from_now> is a boolean that controls the behavior if the timestamp
342 file doesn't exist; if it's true, then it's treated as if it does exist,
343 with the current time -- no old articles are pinged.  If it's false, then
344 every story seen is treated as new.  Defaults to true.
345
346 C<$semi_auto> is a boolean controlling how automatic the pinging is.  If
347 it's false, then the plugin acts in fully automatic mode -- it's always
348 enabled, and any new story is examined.  If it's true, then the plugin
349 acts in semi-automatic mode -- it's only enabled if the URL being browsed
350 includes the paramater "autotrack" (ie, ends with "?autotrack=yes").  By
351 default, this is true.
352
353 C<$networking> controls which networking implementation to use.  If set to
354 "LWP", an implementation which uses the common LWP (libwww-for-perl) perl
355 module set is used; if set to a string that includes the word 'curl', an
356 implementation which uses the external 'curl' utility is used, and the value
357 of $networking is used as the beginning of the command line (this can be used
358 to specify a full path to curl or to pass additional arguments); if set
359 to a string which includes the word 'wget', an implementation which uses the
360 external 'wget' utility is used with $networking used at the beginning of
361 the command line as with curl.  The wget executable must be new enough to
362 include the --post-data option; currently, that means a recent 1.9 beta.
363 Defaults to "LWP".
364
365 C<$debug_level> is an int from 0 to 5 controlling how much debugging output
366 is logged; 0 logs only errors.  Defaults to 1.
367
368 =head2 CSS and Flavour Files
369
370 There is no output, so no customization through these methods.
371
372 =head1 Timestamp
373
374 A timestamp file is kept as $plugin_state_dir/.autotrack.timestamp; stories
375 are considered 'new' if their timestamp is later than the timestamp file
376 (see the C<$start_from_now> variable for the behavior if the file doesn't
377 exist).  There is a small race condition between reading the timestamp
378 file and updating it when the plugin is enabled; one advantage of semi-
379 automatic mode is that this is rarely a problem, since the plugin is only
380 enabled when you want it to be.
381
382 If trackback pings are attempted but they all fail, the timestamp file is
383 reverted to its previous value, so the pings will be tried again later.  if
384 some pings succeed and others fail, however, the timestamp is left with the
385 updated values, and the failed pings won't be retried.
386
387 =head1 THANKS
388
389 * Rael Dornfest -- blosxom (of course) and suggesting $start_from_now option
390 * Taper Wickel -- pointing out wget 1.9's post support
391
392 =head1 LICENSE
393
394 this Blosxom Plug-in
395 Copyright 2003, Todd Larason
396
397 (This license is the same as Blosxom's)
398
399 Permission is hereby granted, free of charge, to any person obtaining a
400 copy of this software and associated documentation files (the "Software"),
401 to deal in the Software without restriction, including without limitation
402 the rights to use, copy, modify, merge, publish, distribute, sublicense,
403 and/or sell copies of the Software, and to permit persons to whom the
404 Software is furnished to do so, subject to the following conditions:
405
406 The above copyright notice and this permission notice shall be included
407 in all copies or substantial portions of the Software.
408
409 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
410 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
411 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
412 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
413 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
414 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
415 OTHER DEALINGS IN THE SOFTWARE.
416
417 =cut
418