File Coverage

blib/lib/Wiki/Toolkit/Feed/Atom.pm
Criterion Covered Total %
statement 28 120 23.3
branch 1 28 3.5
condition 2 11 18.1
subroutine 8 14 57.1
pod 5 7 71.4
total 44 180 24.4


line stmt bran cond sub pod time code
1             package Wiki::Toolkit::Feed::Atom;
2              
3 3     3   1937 use strict;
  3         5  
  3         79  
4              
5 3     3   11 use vars qw( @ISA $VERSION );
  3         1  
  3         157  
6             $VERSION = '0.03';
7              
8 3     3   1428 use POSIX 'strftime';
  3         15134  
  3         23  
9 3     3   4604 use Time::Piece;
  3         23788  
  3         10  
10 3     3   152 use URI::Escape;
  3         17  
  3         177  
11 3     3   12 use Carp qw( croak );
  3         3  
  3         115  
12              
13 3     3   1142 use Wiki::Toolkit::Feed::Listing;
  3         6  
  3         2972  
14             @ISA = qw( Wiki::Toolkit::Feed::Listing );
15              
16             =head1 NAME
17              
18             Wiki::Toolkit::Feed::Atom - A Wiki::Toolkit plugin to output RecentChanges Atom.
19              
20             =head1 DESCRIPTION
21              
22             This is an alternative access to the recent changes of a Wiki::Toolkit
23             wiki. It outputs the Atom Syndication Format as described at
24             L.
25              
26             This module is a straight port of L.
27              
28             =head1 SYNOPSIS
29              
30             use Wiki::Toolkit;
31             use Wiki::Toolkit::Feed::Atom;
32              
33             my $wiki = Wiki::Toolkit->new( ... ); # See perldoc Wiki::Toolkit
34              
35             # Set up the RSS feeder with the mandatory arguments - see
36             # C below for more, optional, arguments.
37             my $atom = Wiki::Toolkit::Feed::Atom->new(
38             wiki => $wiki,
39             site_name => 'My Wiki',
40             site_url => 'http://example.com/',
41             make_node_url => sub
42             {
43             my ($node_name, $version) = @_;
44             return 'http://example.com/?id=' . uri_escape($node_name) . ';version=' . uri_escape($version);
45             },
46             html_equiv_link => 'http://example.com/?RecentChanges',
47             atom_link => 'http://example.com/?action=rc;format=atom',
48             );
49              
50             print "Content-type: application/atom+xml\n\n";
51             print $atom->recent_changes;
52              
53             =head1 METHODS
54              
55             =head2 C
56              
57             my $atom = Wiki::Toolkit::Feed::Atom->new(
58             # Mandatory arguments:
59             wiki => $wiki,
60             site_name => 'My Wiki',
61             site_url => 'http://example.com/',
62             make_node_url => sub
63             {
64             my ($node_name, $version) = @_;
65             return 'http://example.com/?id=' . uri_escape($node_name) . ';version=' . uri_escape($version);
66             },
67             html_equiv_link => 'http://example.com/?RecentChanges',,
68             atom_link => 'http://example.com/?action=rc;format=atom',
69              
70             # Optional arguments:
71             site_description => 'My wiki about my stuff',
72             software_name => $your_software_name, # e.g. "Wiki::Toolkit"
73             software_version => $your_software_version, # e.g. "0.73"
74             software_homepage => $your_software_homepage, # e.g. "http://search.cpan.org/dist/CGI-Wiki/"
75             encoding => 'UTF-8'
76             );
77              
78             C must be a L object. C, if supplied, must
79             be a coderef.
80              
81             The mandatory arguments are:
82              
83             =over 4
84              
85             =item * wiki
86              
87             =item * site_name
88              
89             =item * site_url
90              
91             =item * make_node_url
92              
93             =item * html_equiv_link or recent_changes_link
94              
95             =item * atom_link
96              
97             =back
98              
99             The three optional arguments
100              
101             =over 4
102              
103             =item * software_name
104              
105             =item * software_version
106              
107             =item * software_homepage
108              
109             =back
110              
111             are used to generate the C part of the feed.
112              
113             The optional argument
114              
115             =over 4
116              
117             =item * encoding
118              
119             =back
120              
121             will be used to specify the character encoding in the feed. If not set,
122             will default to the wiki store's encoding.
123              
124             =head2 C
125              
126             $wiki->write_node(
127             'About This Wiki',
128             'blah blah blah',
129             $checksum,
130             {
131             comment => 'Stub page, please update!',
132             username => 'Fred',
133             }
134             );
135              
136             print "Content-type: application/atom+xml\n\n";
137             print $atom->recent_changes;
138              
139             # Or get something other than the default of the latest 15 changes.
140             print $atom->recent_changes( items => 50 );
141             print $atom->recent_changes( days => 7 );
142              
143             # Or ignore minor edits.
144             print $atom->recent_changes( ignore_minor_edits => 1 );
145              
146             # Personalise your feed further - consider only changes
147             # made by Fred to pages about bookshops.
148             print $atom->recent_changes(
149             filter_on_metadata => {
150             username => 'Fred',
151             category => 'Bookshops',
152             },
153             );
154              
155             If using C, note that only changes satisfying
156             I criteria will be returned.
157              
158             B Many of the fields emitted by the Atom generator are taken
159             from the node metadata. The form of this metadata is I mandated
160             by L. Your wiki application should make sure to store some or
161             all of the following metadata when calling C:
162              
163             =over 4
164              
165             =item B - a brief comment summarising the edit that has just been made; will be used in the summary for this item. Defaults to the empty string.
166              
167             =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 'No description given for change'.
168              
169             =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 author for this item. Defaults to 'Anonymous'.
170              
171             =back
172              
173             =cut
174              
175             sub new {
176 6     6 1 2710 my $class = shift;
177 6         8 my $self = {};
178 6         9 bless $self, $class;
179              
180 6         13 my %args = @_;
181 6         7 my $wiki = $args{wiki};
182              
183 6 50 66     38 unless ($wiki && UNIVERSAL::isa($wiki, 'Wiki::Toolkit')) {
184 6         739 croak 'No Wiki::Toolkit object supplied';
185             }
186            
187 0           $self->{wiki} = $wiki;
188            
189             # Mandatory arguments.
190 0           foreach my $arg (qw/site_name site_url make_node_url atom_link/) {
191 0 0         croak "No $arg supplied" unless $args{$arg};
192 0           $self->{$arg} = $args{$arg};
193             }
194              
195             # Must-supply-one-of arguments
196 0           my %mustoneof = ( 'html_equiv_link' => ['html_equiv_link','recent_changes_link'] );
197 0           $self->handle_supply_one_of(\%mustoneof,\%args);
198            
199             # Optional arguments.
200 0           foreach my $arg (qw/site_description software_name software_version software_homepage encoding/) {
201 0   0       $self->{$arg} = $args{$arg} || '';
202             }
203              
204             # Supply some defaults, if a blank string isn't what we want
205 0 0         unless($self->{encoding}) {
206 0           $self->{encoding} = $self->{wiki}->store->{_charset};
207             }
208              
209 0           $self->{timestamp_fmt} = $Wiki::Toolkit::Store::Database::timestamp_fmt;
210 0           $self->{utc_offset} = strftime "%z", localtime;
211 0           $self->{utc_offset} =~ s/(..)(..)$/$1:$2/;
212            
213             # Escape any &'s in the urls
214 0           foreach my $key (qw(site_url atom_link)) {
215 0           my @ands = ($self->{$key} =~ /(\&.{1,6})/g);
216 0           foreach my $and (@ands) {
217 0 0         if($and ne "&") {
218 0           my $new_and = $and;
219 0           $new_and =~ s/\&/\&/;
220 0           $self->{$key} =~ s/$and/$new_and/;
221             }
222             }
223             }
224              
225 0           $self;
226             }
227              
228             # Internal method, to build all the stuff that will go at the start of a feed.
229             # Outputs the feed header, and initial feed info.
230              
231             sub build_feed_start {
232 0     0 0   my ($self,$atom_timestamp) = @_;
233              
234 0           my $generator = '';
235            
236 0 0         if ($self->{software_name}) {
237 0           $generator = '
238 0 0         $generator .= ' uri="' . $self->{software_homepage} . '"' if $self->{software_homepage};
239 0 0         $generator .= ' version=' . $self->{software_version} . '"' if $self->{software_version};
240 0           $generator .= ">\n";
241 0           $generator .= $self->{software_name} . "\n";
242             }
243              
244             my $subtitle = $self->{site_description}
245 0 0         ? '' . $self->{site_description} . "\n"
246             : '';
247              
248 0   0       $atom_timestamp ||= '';
249              
250             my $atom = qq{{encoding} . qq{"?>
251              
252            
253             xmlns = "http://www.w3.org/2005/Atom"
254             xmlns:geo = "http://www.w3.org/2003/01/geo/wgs84_pos#"
255             xmlns:space = "http://frot.org/space/0.1/"
256             >
257              
258            
259             } . $self->{site_name} . qq{
260            
261             } . $atom_timestamp . qq{
262 0           } . $self->{site_url} . qq{
263             $subtitle};
264            
265 0           return $atom;
266             }
267              
268             # Internal method, to build all the stuff that will go at the end of a feed.
269              
270             sub build_feed_end {
271 0     0 0   my ($self,$feed_timestamp) = @_;
272              
273 0           return "\n";
274             }
275              
276             =head2 C
277            
278             Generate and return an Atom feed for a list of nodes
279            
280             =cut
281              
282             sub generate_node_list_feed {
283 0     0 1   my ($self,$atom_timestamp,@nodes) = @_;
284              
285 0           my $atom = $self->build_feed_start($atom_timestamp);
286              
287 0           my (@urls, @items);
288              
289 0           foreach my $node (@nodes) {
290 0           my $node_name = $node->{name};
291              
292 0           my $item_timestamp = $node->{last_modified};
293            
294             # Make a Time::Piece object.
295 0           my $time = Time::Piece->strptime($item_timestamp, $self->{timestamp_fmt});
296              
297 0           my $utc_offset = $self->{utc_offset};
298            
299 0           $item_timestamp = $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" );
300              
301 0   0       my $author = $node->{metadata}{username}[0] || $node->{metadata}{host}[0] || 'Anonymous';
302 0   0       my $description = $node->{metadata}{comment}[0] || 'No description given for node';
303              
304 0 0         $description .= " [$author]" if $author;
305              
306 0           my $version = $node->{version};
307 0 0         my $status = (1 == $version) ? 'new' : 'updated';
308              
309 0           my $major_change = $node->{metadata}{major_change}[0];
310 0 0         $major_change = 1 unless defined $major_change;
311 0 0         my $importance = $major_change ? 'major' : 'minor';
312              
313 0           my $url = $self->{make_node_url}->($node_name, $version);
314              
315             # make XML-clean
316 0           my $title = $node_name;
317 0           $title =~ s/&/&/g;
318 0           $title =~ s/
319 0           $title =~ s/>/>/g;
320              
321             # Pop the categories into atom:category elements (4.2.2)
322             # We can do this because the spec says:
323             # "This specification assigns no meaning to the content (if any)
324             # of this element."
325             # TODO: Decide if we should include the "all categories listing" url
326             # as the scheme (URI) attribute?
327 0           my $category_atom = "";
328 0 0         if ($node->{metadata}->{category}) {
329 0           foreach my $cat (@{ $node->{metadata}->{category} }) {
  0            
330 0           $category_atom .= " \n";
331             }
332             }
333              
334             # Include geospacial data, if we have it
335 0           my $geo_atom = $self->format_geo($node->{metadata});
336              
337             # TODO: Find an Atom equivalent of ModWiki, so we can include more info
338              
339            
340 0           push @items, qq{
341            
342             $title
343            
344             $url
345             $description
346             $item_timestamp
347             $author
348             $category_atom
349             $geo_atom
350            
351             };
352              
353             }
354            
355 0           $atom .= join('', @items) . "\n";
356 0           $atom .= $self->build_feed_end($atom_timestamp);
357              
358 0           return $atom;
359             }
360              
361             =head2 C
362            
363             Generate a very cut down atom feed, based just on the nodes, their locations
364             (if given), and their distance from a reference location (if given).
365              
366             Typically used on search feeds.
367            
368             =cut
369              
370             sub generate_node_name_distance_feed {
371 0     0 1   my ($self,$atom_timestamp,@nodes) = @_;
372              
373 0           my $atom = $self->build_feed_start($atom_timestamp);
374              
375 0           my (@urls, @items);
376              
377 0           foreach my $node (@nodes) {
378 0           my $node_name = $node->{name};
379              
380 0           my $url = $self->{make_node_url}->($node_name);
381              
382             # make XML-clean
383 0           my $title = $node_name;
384 0           $title =~ s/&/&/g;
385 0           $title =~ s/
386 0           $title =~ s/>/>/g;
387              
388             # What location stuff do we have?
389 0           my $geo_atom = $self->format_geo($node);
390              
391 0           push @items, qq{
392            
393             $title
394            
395             $url
396             $geo_atom
397            
398             };
399              
400             }
401            
402 0           $atom .= join('', @items) . "\n";
403 0           $atom .= $self->build_feed_end($atom_timestamp);
404              
405 0           return $atom;
406             }
407              
408             =head2 C
409              
410             print $atom->feed_timestamp();
411              
412             Returns the timestamp of the feed in POSIX::strftime style ("Tue, 29 Feb 2000
413             12:34:56 GMT"), which is equivalent to the timestamp of the most recent item
414             in the feed. Takes the same arguments as recent_changes(). You will most likely
415             need this to print a Last-Modified HTTP header so user-agents can determine
416             whether they need to reload the feed or not.
417              
418             =cut
419              
420             sub feed_timestamp {
421 0     0 1   my ($self, $newest_node) = @_;
422            
423 0           my $time;
424 0 0         if ($newest_node->{last_modified}) {
425 0           $time = Time::Piece->strptime( $newest_node->{last_modified}, $self->{timestamp_fmt} );
426             } else {
427 0           $time = localtime;
428             }
429              
430 0           my $utc_offset = $self->{utc_offset};
431            
432 0           return $time->strftime( "%Y-%m-%dT%H:%M:%S$utc_offset" );
433             }
434              
435              
436             =head2 C
437              
438             Take a feed_timestamp and return a Time::Piece object.
439              
440             =cut
441              
442             sub parse_feed_timestamp {
443 0     0 1   my ($self, $feed_timestamp) = @_;
444            
445 0           $feed_timestamp = substr($feed_timestamp, 0, -length( $self->{utc_offset}));
446 0           return Time::Piece->strptime( $feed_timestamp, '%Y-%m-%dT%H:%M:%S' );
447             }
448             1;
449              
450             __END__