File Coverage

blib/lib/Wiki/Toolkit/Feed/RSS.pm
Criterion Covered Total %
statement 28 141 19.8
branch 1 30 3.3
condition 2 17 11.7
subroutine 8 16 50.0
pod 5 9 55.5
total 44 213 20.6


line stmt bran cond sub pod time code
1             package Wiki::Toolkit::Feed::RSS;
2              
3 3     3   1505 use strict;
  3         4  
  3         75  
4              
5 3     3   9 use vars qw( @ISA $VERSION );
  3         3  
  3         138  
6             $VERSION = '0.11';
7              
8 3     3   1429 use POSIX 'strftime';
  3         12623  
  3         11  
9 3     3   3712 use Time::Piece;
  3         20986  
  3         9  
10 3     3   151 use URI::Escape;
  3         4  
  3         139  
11 3     3   10 use Carp qw( croak );
  3         3  
  3         102  
12              
13 3     3   1175 use Wiki::Toolkit::Feed::Listing;
  3         6  
  3         3488  
14             @ISA = qw( Wiki::Toolkit::Feed::Listing );
15              
16             =head1 NAME
17              
18             Wiki::Toolkit::Feed::RSS - Output RecentChanges RSS for Wiki::Toolkit.
19              
20             =head1 DESCRIPTION
21              
22             This is an alternative access to the recent changes of a Wiki::Toolkit
23             wiki. It outputs RSS as described by the ModWiki proposal at
24             L
25              
26             =head1 SYNOPSIS
27              
28             use Wiki::Toolkit;
29             use Wiki::Toolkit::Feed::RSS;
30              
31             my $wiki = CGI::Wiki->new( ... ); # See perldoc Wiki::Toolkit
32              
33             # Set up the RSS feeder with the mandatory arguments - see
34             # C below for more, optional, arguments.
35             my $rss = Wiki::Toolkit::Feed::RSS->new(
36             wiki => $wiki,
37             site_name => 'My Wiki',
38             site_url => 'http://example.com/',
39             make_node_url => sub
40             {
41             my ($node_name, $version) = @_;
42             return 'http://example.com/?id=' . uri_escape($node_name) . ';version=' . uri_escape($version);
43             },
44             html_equiv_link => 'http://example.com/?RecentChanges',
45             encoding => 'UTF-8'
46             );
47              
48             print "Content-type: application/xml\n\n";
49             print $rss->recent_changes;
50              
51             =head1 METHODS
52              
53             =head2 C
54              
55             my $rss = Wiki::Toolkit::Feed::RSS->new(
56             # Mandatory arguments:
57             wiki => $wiki,
58             site_name => 'My Wiki',
59             site_url => 'http://example.com/',
60             make_node_url => sub
61             {
62             my ($node_name, $version) = @_;
63             return 'http://example.com/?id=' . uri_escape($node_name) . ';version=' . uri_escape($version);
64             },
65             html_equiv_link => 'http://example.com/?RecentChanges',
66              
67             # Optional arguments:
68             site_description => 'My wiki about my stuff',
69             interwiki_identifier => 'MyWiki',
70             make_diff_url => sub
71             {
72             my $node_name = shift;
73             return 'http://example.com/?diff=' . uri_escape($node_name)
74             },
75             make_history_url => sub
76             {
77             my $node_name = shift;
78             return 'http://example.com/?hist=' . uri_escape($node_name)
79             },
80             software_name => $your_software_name, # e.g. "CGI::Wiki"
81             software_version => $your_software_version, # e.g. "0.73"
82             software_homepage => $your_software_homepage, # e.g. "http://search.cpan.org/dist/Wiki-Toolkit/"
83             );
84              
85             C must be a L object. C, and
86             C and C, if supplied, must be coderefs.
87              
88             The mandatory arguments are:
89              
90             =over 4
91              
92             =item * wiki
93              
94             =item * site_name
95              
96             =item * site_url
97              
98             =item * make_node_url
99              
100             =item * html_equiv_link or recent_changes_link
101              
102             =back
103              
104             The three optional arguments
105              
106             =over 4
107              
108             =item * software_name
109              
110             =item * software_version
111              
112             =item * software_homepage
113              
114             =back
115              
116             are used to generate DOAP (Description Of A Project - see L) metadata
117             for the feed to show what generated it.
118              
119             The optional argument
120              
121             =over 4
122              
123             =item * encoding
124              
125             =back
126              
127             will be used to specify the character encoding in the feed. If not set,
128             will default to the wiki store's encoding.
129              
130             =head2 C
131              
132             $wiki->write_node(
133             'About This Wiki',
134             'blah blah blah',
135             $checksum,
136             {
137             comment => 'Stub page, please update!',
138             username => 'Fred',
139             }
140             );
141              
142             print "Content-type: application/xml\n\n";
143             print $rss->recent_changes;
144              
145             # Or get something other than the default of the latest 15 changes.
146             print $rss->recent_changes( items => 50 );
147             print $rss->recent_changes( days => 7 );
148              
149             # Or ignore minor edits.
150             print $rss->recent_changes( ignore_minor_edits => 1 );
151              
152             # Personalise your feed further - consider only changes
153             # made by Fred to pages about bookshops.
154             print $rss->recent_changes(
155             filter_on_metadata => {
156             username => 'Fred',
157             category => 'Bookshops',
158             },
159             );
160              
161             If using C, note that only changes satisfying
162             I criteria will be returned.
163              
164             B Many of the fields emitted by the RSS generator are taken
165             from the node metadata. The form of this metadata is I mandated
166             by L. Your wiki application should make sure to store some or
167             all of the following metadata when calling C:
168              
169             =over 4
170              
171             =item B - a brief comment summarising the edit that has just been made; will be used in the RDF description for this item. Defaults to the empty string.
172              
173             =item B - an identifier for the person who made the edit; will be used as the Dublin Core contributor for this item, and also in the RDF description. Defaults to the empty string.
174              
175             =item B - the hostname or IP address of the computer used to make the edit; if no username is supplied then this will be used as the Dublin Core contributor for this item. Defaults to the empty string.
176              
177             =item B - true if the edit was a major edit and false if it was a minor edit; used for the importance of the item. Defaults to true (ie if C was not defined or was explicitly stored as C).
178              
179             =back
180              
181             =head2 C
182              
183             print $rss->feed_timestamp();
184              
185             Returns the timestamp of the feed in POSIX::strftime style ("Tue, 29 Feb 2000
186             12:34:56 GMT"), which is equivalent to the timestamp of the most recent item
187             in the feed. Takes the same arguments as recent_changes(). You will most likely
188             need this to print a Last-Modified HTTP header so user-agents can determine
189             whether they need to reload the feed or not.
190              
191             =cut
192              
193             sub new {
194 6     6 1 2002 my $class = shift;
195 6         8 my $self = {};
196 6         10 bless $self, $class;
197              
198 6         13 my %args = @_;
199 6         6 my $wiki = $args{wiki};
200              
201 6 50 66     41 unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) {
202 6         728 croak 'No Wiki::Toolkit object supplied';
203             }
204            
205 0           $self->{wiki} = $wiki;
206            
207             # Mandatory arguments.
208 0           foreach my $arg (qw/site_name site_url make_node_url/) {
209 0 0         croak "No $arg supplied" unless $args{$arg};
210 0           $self->{$arg} = $args{$arg};
211             }
212              
213             # Must-supply-one-of arguments
214 0           my %mustoneof = ( 'html_equiv_link' => ['html_equiv_link','recent_changes_link'] );
215 0           $self->handle_supply_one_of(\%mustoneof,\%args);
216            
217             # Optional arguments.
218 0           foreach my $arg (qw/site_description interwiki_identifier make_diff_url make_history_url encoding software_name software_version software_homepage/) {
219 0   0       $self->{$arg} = $args{$arg} || '';
220             }
221              
222             # Supply some defaults, if a blank string isn't what we want
223 0 0         unless($self->{encoding}) {
224 0           $self->{encoding} = $self->{wiki}->store->{_charset};
225             }
226              
227 0           $self->{timestamp_fmt} = $Wiki::Toolkit::Store::Database::timestamp_fmt;
228 0           $self->{utc_offset} = strftime "%z", localtime;
229 0           $self->{utc_offset} =~ s/(..)(..)$/$1:$2/;
230              
231 0           $self;
232             }
233              
234             # Internal method, to build all the stuff that will go at the start of a feed.
235             # Generally will output namespaces, headers and so on.
236              
237             sub build_feed_start {
238 0     0 0   my ($self,$feed_timestamp) = @_;
239              
240             #"http://purl.org/rss/1.0/modules/wiki/"
241 0           return qq{{encoding} .qq{"?>
242              
243            
244             xmlns = "http://purl.org/rss/1.0/"
245             xmlns:dc = "http://purl.org/dc/elements/1.1/"
246             xmlns:doap = "http://usefulinc.com/ns/doap#"
247             xmlns:foaf = "http://xmlns.com/foaf/0.1/"
248             xmlns:rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
249             xmlns:rdfs = "http://www.w3.org/2000/01/rdf-schema#"
250             xmlns:modwiki = "http://www.usemod.com/cgi-bin/mb.pl?ModWiki"
251             xmlns:geo = "http://www.w3.org/2003/01/geo/wgs84_pos#"
252             xmlns:space = "http://frot.org/space/0.1/"
253             >
254             };
255             }
256              
257             # Internal method, to build all the stuff (except items) to go inside the channel
258              
259             sub build_feed_mid {
260 0     0 0   my ($self,$feed_timestamp) = @_;
261              
262 0           my $rss .= qq{} . $self->{site_url} . qq{\n};
263              
264 0 0         if ($self->{software_name}) {
265             $rss .= qq{
266            
267 0           } . $self->{software_name} . qq{\n};
268             }
269              
270 0 0 0       if ($self->{software_name} && $self->{software_homepage}) {
271 0           $rss .= qq{ \n};
272             }
273              
274 0 0 0       if ($self->{software_name} && $self->{software_version}) {
275             $rss .= qq{
276            
277 0           } . $self->{software_version} . qq{
278            
279             \n};
280             }
281              
282 0 0         if ($self->{software_name}) {
283 0           $rss .= qq{
284             \n};
285             }
286              
287 0   0       $feed_timestamp ||= '';
288              
289             $rss .= qq{} . $self->{site_name} . qq{
290             } . $self->{html_equiv_link} . qq{
291             } . $self->{site_description} . qq{
292             } . $feed_timestamp . qq{
293 0           } . $self->{interwiki_identifier} . qq{};
294              
295 0           return $rss;
296             }
297              
298             # Internal method, to build all the stuff that will go at the end of a feed
299              
300             sub build_feed_end {
301 0     0 0   my ($self,$feed_timestamp) = @_;
302              
303 0           return "\n";
304             }
305              
306              
307             =head2 C
308              
309             Generate and return an RSS feed for a list of nodes
310              
311             =cut
312              
313             sub generate_node_list_feed {
314 0     0 1   my ($self,$feed_timestamp,@nodes) = @_;
315              
316             # Start our feed
317 0           my $rss = $self->build_feed_start($feed_timestamp);
318 0           $rss .= qq{
319              
320            
321              
322             };
323 0           $rss .= $self->build_feed_mid($feed_timestamp);
324              
325             # Generate the items list, and the individiual item entries
326 0           my (@urls, @items);
327 0           foreach my $node (@nodes) {
328 0           my $node_name = $node->{name};
329              
330 0           my $timestamp = $node->{last_modified};
331            
332             # Make a Time::Piece object.
333 0           my $time = Time::Piece->strptime($timestamp, $self->{timestamp_fmt});
334              
335 0           my $utc_offset = $self->{utc_offset};
336            
337 0           $timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" );
338              
339 0   0       my $author = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || '';
340 0   0       my $description = $node->{metadata}{comment}[0] || '';
341              
342 0 0         $description .= " [$author]" if $author;
343              
344 0           my $version = $node->{version};
345 0 0         my $status = (1 == $version) ? 'new' : 'updated';
346              
347 0           my $major_change = $node->{metadata}{major_change}[0];
348 0 0         $major_change = 1 unless defined $major_change;
349 0 0         my $importance = $major_change ? 'major' : 'minor';
350              
351 0           my $url = $self->{make_node_url}->($node_name, $version);
352              
353 0           push @urls, qq{ \n};
354              
355 0           my $diff_url = '';
356            
357 0 0         if ($self->{make_diff_url}) {
358 0           $diff_url = $self->{make_diff_url}->($node_name);
359             }
360              
361 0           my $history_url = '';
362            
363 0 0         if ($self->{make_history_url}) {
364 0           $history_url = $self->{make_history_url}->($node_name);
365             }
366              
367 0           my $node_url = $self->{make_node_url}->($node_name);
368              
369 0           my $rdf_url = $node_url;
370 0           $rdf_url =~ s/\?/\?id=/;
371 0           $rdf_url .= ';format=rdf';
372              
373             # make XML-clean
374 0           my $title = $node_name;
375 0           $title =~ s/&/&/g;
376 0           $title =~ s/
377 0           $title =~ s/>/>/g;
378              
379             # Pop the categories into dublin core subject elements
380             # (http://dublincore.org/usage/terms/history/#subject-004)
381             # TODO: Decide if we should include the "all categories listing" url
382             # as the scheme (URI) attribute?
383 0           my $category_rss = "";
384 0 0         if($node->{metadata}->{category}) {
385 0           foreach my $cat (@{ $node->{metadata}->{category} }) {
  0            
386 0           $category_rss .= " $cat\n";
387             }
388             }
389              
390             # Include geospacial data, if we have it
391 0           my $geo_rss = $self->format_geo($node->{metadata});
392              
393 0           push @items, qq{
394            
395             $title
396             $url
397             $description
398             $timestamp
399             $author
400             $status
401             $importance
402             $diff_url
403             $version
404             $history_url
405            
406             $category_rss
407             $geo_rss
408            
409             };
410             }
411            
412             # Output the items list
413 0           $rss .= qq{
414              
415            
416            
417             } . join('', @urls) . qq{
418            
419              
420            
421             };
422              
423             # Output the individual item entries
424 0           $rss .= join('', @items) . "\n";
425              
426             # Finish up
427 0           $rss .= $self->build_feed_end($feed_timestamp);
428            
429 0           return $rss;
430             }
431              
432              
433             =head2 C
434              
435             Generate a very cut down rss feed, based just on the nodes, their locations
436             (if given), and their distance from a reference location (if given).
437              
438             Typically used on search feeds.
439              
440             =cut
441              
442             sub generate_node_name_distance_feed {
443 0     0 1   my ($self,$feed_timestamp,@nodes) = @_;
444              
445             # Start our feed
446 0           my $rss = $self->build_feed_start($feed_timestamp);
447 0           $rss .= qq{
448              
449            
450              
451             };
452 0           $rss .= $self->build_feed_mid($feed_timestamp);
453              
454             # Generate the items list, and the individiual item entries
455 0           my (@urls, @items);
456 0           foreach my $node (@nodes) {
457 0           my $node_name = $node->{name};
458              
459 0           my $url = $self->{make_node_url}->($node_name);
460              
461 0           push @urls, qq{ \n};
462              
463 0           my $rdf_url = $url;
464 0           $rdf_url =~ s/\?/\?id=/;
465 0           $rdf_url .= ';format=rdf';
466              
467             # make XML-clean
468 0           my $title = $node_name;
469 0           $title =~ s/&/&/g;
470 0           $title =~ s/
471 0           $title =~ s/>/>/g;
472              
473             # What location stuff do we have?
474 0           my $geo_rss = $self->format_geo($node);
475              
476 0           push @items, qq{
477            
478             $title
479             $url
480            
481             $geo_rss
482            
483             };
484             }
485            
486             # Output the items list
487 0           $rss .= qq{
488              
489            
490            
491             } . join('', @urls) . qq{
492            
493              
494            
495             };
496              
497             # Output the individual item entries
498 0           $rss .= join('', @items) . "\n";
499              
500             # Finish up
501 0           $rss .= $self->build_feed_end($feed_timestamp);
502            
503 0           return $rss;
504             }
505              
506             =head2 C
507              
508             Generate the timestamp for the RSS, based on the newest node (if available).
509             Will return a timestamp for now if no node dates are available
510              
511             =cut
512              
513             sub feed_timestamp {
514 0     0 1   my ($self, $newest_node) = @_;
515              
516 0           my $time;
517 0 0         if ($newest_node->{last_modified}) {
518 0           $time = Time::Piece->strptime( $newest_node->{last_modified}, $self->{timestamp_fmt} );
519             } else {
520 0           $time = localtime;
521             }
522              
523 0           my $utc_offset = $self->{utc_offset};
524              
525 0           return $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" );
526             }
527              
528             # Compatibility method - use feed_timestamp with a node instead
529             sub rss_timestamp {
530 0     0 0   my ($self, %args) = @_;
531              
532 0           warn("Old style method used - please convert to calling feed_timestamp with a node!");
533 0           my $feed_timestamp = $self->feed_timestamp(
534             $self->fetch_newest_for_recently_changed(%args)
535             );
536 0           return $feed_timestamp;
537             }
538              
539             =head2 C
540              
541             Take a feed_timestamp and return a Time::Piece object.
542              
543             =cut
544              
545             sub parse_feed_timestamp {
546 0     0 1   my ($self, $feed_timestamp) = @_;
547            
548 0           $feed_timestamp = substr($feed_timestamp, 0, -length( $self->{utc_offset}));
549 0           return Time::Piece->strptime( $feed_timestamp, '%Y-%m-%dT%H:%M:%S' );
550             }
551              
552             1;
553              
554             __END__