Address a few RSS and Atom feed validation problems:
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / WWW / SuperCat / Feed.pm
1 package OpenILS::WWW::SuperCat::Feed;
2 use strict; use warnings;
3 use vars qw/$parser/;
4 use OpenSRF::EX qw(:try);
5 use XML::LibXML;
6 use XML::LibXSLT;
7 use OpenSRF::Utils::SettingsClient;
8 use CGI;
9 use DateTime;
10 use DateTime::Format::Mail;
11
12
13 sub exists {
14         my $class = shift;
15         my $type = shift;
16
17         return 1 if UNIVERSAL::can("OpenILS::WWW::SuperCat::Feed::$type" => 'new');
18         return 0;
19 }
20
21 sub new {
22         my $class = shift;
23         my $type = shift;
24         if ($type) {
25                 $class .= '::'.$type;
26                 return $class->new;
27         }
28         throw OpenSRF::EX::ERROR ("I need a feed type!") ;
29 }
30
31 sub build {
32         my $class = shift;
33         my $xml = shift;
34         return undef unless $xml;
35
36         $parser = new XML::LibXML if (!$parser);
37
38         my $self = { doc => $parser->parse_string($xml), items => [] };
39
40         $self = bless $self => $class;
41         $self->{count} = 0;
42         return $self;
43 }
44
45 sub type {
46         my $self = shift;
47         my $type = shift;
48         $self->{type} = $type if ($type);
49         return $self->{type};
50 }
51
52 sub count {
53         my $self = shift;
54         return $self->{count};
55 }
56
57 sub search {
58         my $self = shift;
59         my $search = shift;
60         $self->{search} = $search if ($search);
61         return $self->{search};
62 }
63
64 sub class {
65         my $self = shift;
66         my $search = shift;
67         $self->{class} = $search if ($search);
68         return $self->{class};
69 }
70
71 sub Sort {
72         my $self = shift;
73         my $search = shift;
74         $self->{sort} = $search if ($search);
75         return $self->{sort};
76 }
77
78 sub SortDir {
79         my $self = shift;
80         my $search = shift;
81         $self->{sort_dir} = $search if ($search);
82         return $self->{sort_dir};
83 }
84
85 sub lang {
86         my $self = shift;
87         my $search = shift;
88         $self->{lang} = $search if ($search);
89         return $self->{lang};
90 }
91
92 sub lib {
93         my $self = shift;
94         my $lib = shift;
95         $self->{lib} = $lib if ($lib);
96         return $self->{lib};
97 }
98
99 sub base {
100         my $self = shift;
101         my $base = shift;
102         $self->{base} = $base if ($base);
103         return $self->{base};
104 }
105
106 sub root {
107         my $self = shift;
108         my $root = shift;
109         $self->{root} = $root if ($root);
110         return $self->{root};
111 }
112
113 sub unapi {
114         my $self = shift;
115         my $unapi = shift;
116         $self->{unapi} = $unapi if ($unapi);
117         return $self->{unapi};
118 }
119
120 sub push_item {
121         my $self = shift;
122         $self->{count} += scalar(@_);
123         push @{ $self->{items} }, @_;
124 }
125
126 sub items {
127         my $self = shift;
128         return @{ $self->{items} } if (wantarray);
129         return $self->{items};
130 }
131
132 sub _add_node {
133         my $self = shift;
134
135         my $xpath = shift;
136         my $new = shift;
137
138         for my $node ($self->{doc}->findnodes($xpath)) {
139                 $node->appendChild($new);
140                 last;
141         }
142 }
143
144 sub _create_node {
145         my $self = shift;
146
147         my $xpath = shift;
148         my $ns = shift;
149         my $name = shift;
150         my $text = shift;
151         my $attrs = shift;
152
153         for my $node ($self->{doc}->findnodes($xpath)) {
154                 my $new = $self->{doc}->createElement($name) if (!$ns);
155                 $new = $self->{doc}->createElementNS($ns,$name) if ($ns);
156
157                 $new->appendChild( $self->{doc}->createTextNode( $text ) )
158                         if (defined $text);
159
160                 if (ref($attrs)) {
161                         for my $key (keys %$attrs) {
162                                 next unless $$attrs{$key};
163                                 $new->setAttribute( $key => $$attrs{$key} );
164                         }
165                 }
166
167                 $node->appendChild( $new );
168
169                 return $new;
170         }
171 }
172
173 sub add_item {
174         my $self = shift;
175         my $class = ref($self) || $self;
176         $class .= '::item';
177
178         my $item_xml = shift;
179         my $entry = $class->new($item_xml);
180         return undef unless $entry;
181
182         $entry->base($self->base);
183         $entry->unapi($self->unapi);
184
185         $self->push_item($entry);
186         return $entry;
187 }
188
189 sub add_holdings {
190         my $self = shift;
191         my $holdings_xml = shift;
192
193         return $self unless ($holdings_xml);
194
195         $parser = new XML::LibXML if (!$parser);
196         my $new_doc = $parser->parse_string($holdings_xml);
197
198         for my $root ( $self->{doc}->findnodes($self->{holdings_xpath}) ) {
199                 $root->appendChild($new_doc->documentElement);
200                 last;
201         }
202         return $self;
203 }
204
205 sub composeDoc {
206         my $self = shift;
207         for my $root ( $self->{doc}->findnodes($self->{item_xpath}) ) {
208                 for my $item ( $self->items ) {
209                         $root->appendChild( $item->{doc}->documentElement );
210                 }
211                 last;
212         }
213 }
214
215 sub toString {
216         my $self = shift;
217         $self->composeDoc;
218         return $self->{doc}->toString(1);
219 }
220
221 sub id {};
222 sub link {};
223 sub title {};
224 sub update_ts {};
225 sub creator {};
226
227 #----------------------------------------------------------
228
229 package OpenILS::WWW::SuperCat::Feed::atom;
230 use base 'OpenILS::WWW::SuperCat::Feed';
231 use OpenSRF::Utils qw/:datetime/;
232
233 sub new {
234         my $class = shift;
235         my $self = $class->SUPER::build('<feed xmlns:atom="http://www.w3.org/2005/Atom"/>');
236         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef);
237         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
238         $self->{type} = 'application/atom+xml';
239         $self->{item_xpath} = '/atom:feed';
240         return $self;
241 }
242
243 sub title {
244         my $self = shift;
245         my $text = shift;
246         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','title', $text);
247 }
248
249 sub update_ts {
250         my $self = shift;
251         # ATOM demands RFC-3339 compliant datetime formats
252         my $text = shift || gmtime_ISO8601();
253         $self->_create_node($self->{item_xpath},'http://www.w3.org/2005/Atom','updated', $text);
254 }
255
256 sub creator {
257         my $self = shift;
258         my $text = shift;
259         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','author');
260         $self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','name', $text);
261 }
262
263 sub link {
264         my $self = shift;
265         my $type = shift;
266         my $id = shift;
267         my $mime = shift || "application/x-$type+xml";
268         my $title = shift;
269
270         $type = 'self' if ($type eq 'atom');
271
272         $self->_create_node(
273                 $self->{item_xpath},
274                 'http://www.w3.org/2005/Atom',
275                 'link',
276                 undef,
277                 { rel => $type,
278                   href => $id,
279                   title => $title,
280                   type => $mime,
281                 }
282         );
283 }
284
285 sub id {
286         my $self = shift;
287         my $id = shift;
288
289         $self->_create_node( $self->{item_xpath}, 'http://www.w3.org/2005/Atom', 'id', $id );
290 }
291
292 package OpenILS::WWW::SuperCat::Feed::atom::item;
293 use base 'OpenILS::WWW::SuperCat::Feed::atom';
294
295 sub new {
296         my $class = shift;
297         my $xml = shift;
298         my $self = $class->SUPER::build($xml);
299         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef);
300         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
301         $self->{item_xpath} = '/atom:entry';
302         $self->{holdings_xpath} = '/atom:entry';
303         $self->{type} = 'application/atom+xml';
304         return $self;
305 }
306
307
308 #----------------------------------------------------------
309
310 package OpenILS::WWW::SuperCat::Feed::rss2;
311 use base 'OpenILS::WWW::SuperCat::Feed';
312
313 sub new {
314         my $class = shift;
315         my $self = $class->SUPER::build('<rss version="2.0"><channel/></rss>');
316         $self->{type} = 'application/rss+xml';
317         $self->{item_xpath} = '/rss/channel';
318         return $self;
319 }
320
321 sub title {
322         my $self = shift;
323         my $text = shift;
324         $self->_create_node('/rss/channel',undef,'title', $text);
325         # RSS2 demands a /channel/description element; just dupe title until we give
326         # users the ability to provide a description for their bookbags
327         $self->_create_node('/rss/channel',undef,'description', $text);
328 }
329
330 sub update_ts {
331         my $self = shift;
332         # RSS2 demands RFC-822 compliant datetime formats
333         my $text = shift || DateTime::Format::Mail->format_datetime(DateTime->now());
334         $self->_create_node($self->{item_xpath},undef,'lastBuildDate', $text);
335 }
336
337 sub creator {
338         my $self = shift;
339         my $text = shift;
340         $self->_create_node('/rss/channel', undef,'generator', $text);
341 }
342
343 sub link {
344         my $self = shift;
345         my $type = shift;
346         my $id = shift;
347         my $mime = shift || "application/x-$type+xml";
348
349         if ($type eq 'rss2' or $type eq 'alternate') {
350                 # Just link to ourself using standard RSS2 link element
351                 $self->_create_node(
352                         $self->{item_xpath},
353                         undef,
354                         'link',
355                         $id,
356                         undef
357                 );
358         } else {
359                 # Alternate link: use XHTML link element
360                 $self->_create_node(
361                         $self->{item_xpath},
362                         'http://www.w3.org/1999/xhtml',
363                         'xhtml:link',
364                         $id,
365                         { rel => $type,
366                           type => $mime,
367                         }
368                 );
369         }
370 }
371
372 sub id {
373         my $self = shift;
374         my $id = shift;
375
376         $self->_create_node($self->{item_xpath}, undef,'guid', $id);
377 }
378
379 package OpenILS::WWW::SuperCat::Feed::rss2::item;
380 use base 'OpenILS::WWW::SuperCat::Feed::rss2';
381
382 sub new {
383         my $class = shift;
384         my $xml = shift;
385         my $self = $class->SUPER::build($xml);
386         $self->{type} = 'application/rss+xml';
387         $self->{item_xpath} = '/item';
388         $self->{holdings_xpath} = '/item';
389         return $self;
390 }
391
392 sub update_ts {
393         my $self = shift;
394         # RSS2 demands RFC-822 compliant datetime formats
395         my $text = shift;
396         if (!$text) {
397                 # No date passed in, default to now
398                 $text = DateTime::Format::Mail->format_datetime(DateTime->now());
399         } elsif ($text =~ m/^\s*(\d{4})\.?\s*$/o) {
400                 # Publication date is just a year, convert accordingly
401                 my $year = DateTime->new(year=>$1);
402                 $text = DateTime::Format::Mail->format_datetime($year);
403         }
404         $self->_create_node($self->{item_xpath},undef,'pubDate', $text);
405 }
406
407 sub id {
408         my $self = shift;
409         my $id = shift;
410
411         $self->_create_node(
412                 $self->{item_xpath},
413                 undef,
414                 'guid',
415                 $id,
416                 {
417                         isPermaLink=>"false"
418                 }
419         );
420 }
421
422 #----------------------------------------------------------
423
424 package OpenILS::WWW::SuperCat::Feed::mods;
425 use base 'OpenILS::WWW::SuperCat::Feed';
426
427 sub new {
428         my $class = shift;
429         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/"/>');
430         $self->{type} = 'application/xml';
431         $self->{item_xpath} = '/mods:modsCollection';
432         return $self;
433 }
434
435 package OpenILS::WWW::SuperCat::Feed::mods::item;
436 use base 'OpenILS::WWW::SuperCat::Feed::mods';
437
438 sub new {
439         my $class = shift;
440         my $xml = shift;
441         my $self = $class->SUPER::build($xml);
442         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', undef);
443         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods');
444         $self->{type} = 'application/xml';
445         $self->{holdings_xpath} = '/mods:mods';
446         return $self;
447 }
448
449 my $linkid = 1;
450
451 sub link {
452         my $self = shift;
453         my $type = shift;
454         my $id = shift;
455
456         if ($type eq 'unapi' || $type eq 'opac') {
457                 $self->_create_node(
458                         'mods:mods',
459                         'http://www.loc.gov/mods/',
460                         'mods:relatedItem',
461                         undef,
462                         { type => 'otherFormat', id => 'link-'.$linkid }
463                 );
464                 $self->_create_node(
465                         "mods:mods/mods:relatedItem[\@id='link-$linkid']",
466                         'http://www.loc.gov/mods/',
467                         'mods:recordIdentifier',
468                         $id
469                 );
470                 $linkid++;
471         }
472 }
473
474
475 #----------------------------------------------------------
476
477 package OpenILS::WWW::SuperCat::Feed::mods3;
478 use base 'OpenILS::WWW::SuperCat::Feed::mods';
479
480 sub new {
481         my $class = shift;
482         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/v3"/>');
483         $self->{type} = 'application/xml';
484         $self->{item_xpath} = '/mods:modsCollection';
485         return $self;
486 }
487
488 package OpenILS::WWW::SuperCat::Feed::mods3::item;
489 use base 'OpenILS::WWW::SuperCat::Feed::mods::item';
490
491 sub new {
492         my $class = shift;
493         my $xml = shift;
494         my $self = $class->SUPER::build($xml);
495         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', undef);
496         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', 'mods');
497         $self->{type} = 'application/xml';
498         $self->{holdings_xpath} = '/mods:mods';
499         return $self;
500 }
501
502 sub link {
503         my $self = shift;
504         my $type = shift;
505         my $id = shift;
506
507         if ($type eq 'unapi' || $type eq 'opac') {
508                 $self->_create_node(
509                         'mods:mods',
510                         'http://www.loc.gov/mods/v3',
511                         'mods:relatedItem',
512                         undef,
513                         { type => 'otherFormat', id => 'link-'.$linkid }
514                 );
515                 $self->_create_node(
516                         "mods:mods/mods:relatedItem[\@id='link-$linkid']",
517                         'http://www.loc.gov/mods/v3',
518                         'mods:recordIdentifier',
519                         $id
520                 );
521                 $linkid++;
522         }
523 }
524
525
526 #----------------------------------------------------------
527
528 package OpenILS::WWW::SuperCat::Feed::marcxml;
529 use base 'OpenILS::WWW::SuperCat::Feed';
530
531 sub new {
532         my $class = shift;
533         my $self = $class->SUPER::build('<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim"/>');
534         $self->{type} = 'application/xml';
535         $self->{item_xpath} = '/marc:collection';
536         return $self;
537 }
538 sub link {
539         my $self = shift;
540         my $type = shift;
541         my $id = shift;
542
543         if ($type eq 'unapi') {
544                 $self->_create_node(
545                         'marc:collection',
546                         'http://www.w3.org/1999/xhtml',
547                         'xhtml:link',
548                         undef,
549                         { rel => 'unapi-server', href => $id, title => "unapi" }
550                 );
551                 $linkid++;
552         }
553 }
554
555
556 package OpenILS::WWW::SuperCat::Feed::marcxml::item;
557 use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
558
559 sub new {
560         my $class = shift;
561         my $xml = shift;
562         my $self = $class->SUPER::build($xml);
563         return undef unless $self;
564         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', undef);
565         $self->{type} = 'application/xml';
566         $self->{holdings_xpath} = '/*[local-name()="record"]';
567         return $self;
568 }
569
570 sub link {
571         my $self = shift;
572         my $type = shift;
573         my $id = shift;
574
575         if ($type eq 'opac') {
576                 $self->_create_node(
577                         '*[local-name()="record"]',
578                         'http://www.w3.org/1999/xhtml',
579                         'xhtml:link',
580                         undef,
581                         { rel => 'otherFormat', href => $id, title => "Dynamic Details" }
582                 );
583                 $linkid++;
584         } elsif ($type eq 'unapi-id') {
585                 $self->_create_node(
586                         '*[local-name()="record"]',
587                         'http://www.w3.org/1999/xhtml',
588                         'xhtml:abbr',
589                         undef,
590                         {  title => $id, class => "unapi-id" }
591                 );
592                 $linkid++;
593         }
594 }
595
596
597 #----------------------------------------------------------
598
599 package OpenILS::WWW::SuperCat::Feed::html;
600 use base 'OpenILS::WWW::SuperCat::Feed::atom';
601
602 sub new {
603         my $class = shift;
604         my $self = $class->SUPER::new;
605         $self->type('text/html');
606         return $self;
607 }
608
609 our ($_parser, $_xslt, $xslt_file);
610
611 sub toString {
612         my $self = shift;
613         my $base = $self->base || '';
614         my $root = $self->root || '';
615         my $search = $self->search || '';
616         my $class = $self->class || '';
617         my $lib = $self->lib || '-';
618
619         $self->composeDoc;
620
621         $_parser ||= new XML::LibXML;
622         $_xslt ||= new XML::LibXSLT;
623
624         $xslt_file ||=
625                 OpenSRF::Utils::SettingsClient
626                         ->new
627                         ->config_value( dirs => 'xsl' ).
628                 "/ATOM2XHTML.xsl";
629
630         # parse the MODS xslt ...
631         my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
632
633         my $new_doc = $atom2html_xslt->transform(
634                 $self->{doc},
635                 base_dir => "'$root'",
636                 lib => "'$lib'",
637                 searchTerms => "'$search'",
638                 searchClass => "'$class'",
639         );
640
641         return $new_doc->toString(1); 
642 }
643
644
645 package OpenILS::WWW::SuperCat::Feed::html::item;
646 use base 'OpenILS::WWW::SuperCat::Feed::atom::item';
647
648 #----------------------------------------------------------
649
650 package OpenILS::WWW::SuperCat::Feed::htmlcard;
651 use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
652
653 sub new {
654         my $class = shift;
655         my $self = $class->SUPER::new;
656         $self->type('text/html');
657         $self->{xsl} = "/MARC21slim2HTMLCard.xsl";
658         return $self;
659 }
660
661 our ($_parser, $_xslt, $xslt_file);
662
663 sub toString {
664         my $self = shift;
665         my $base = $self->base || '';
666         my $root = $self->root || '';
667         my $search = $self->search || '';
668         my $sort = $self->Sort || '';
669         my $sort_dir = $self->SortDir || '';
670         my $lang = $self->lang || '';
671         my $lib = $self->lib || '-';
672
673         $self->composeDoc;
674
675         $_parser ||= new XML::LibXML;
676         $_xslt ||= new XML::LibXSLT;
677
678         $xslt_file =
679                 OpenSRF::Utils::SettingsClient
680                         ->new
681                         ->config_value( dirs => 'xsl' ).$self->{xsl};
682
683         # parse the MODS xslt ...
684         my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
685
686         my $new_doc = $atom2html_xslt->transform(
687                 $self->{doc},
688                 base_dir => "'$root'",
689                 lib => "'$lib'",
690                 searchTerms => "'$search'",
691                 searchSort => "'$sort'",
692                 searchSortDir => "'$sort_dir'",
693                 searchLang => "'$lang'",
694         );
695
696         return $new_doc->toString(1); 
697 }
698
699 package OpenILS::WWW::SuperCat::Feed::htmlcard::item;
700 use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item';
701
702 package OpenILS::WWW::SuperCat::Feed::htmlholdings;
703 use base 'OpenILS::WWW::SuperCat::Feed::htmlcard';
704
705 sub new {
706         my $class = shift;
707         my $self = $class->SUPER::new;
708         $self->{xsl} = "/MARC21slim2HTMLCard-holdings.xsl";
709         return $self;
710 }
711
712 package OpenILS::WWW::SuperCat::Feed::htmlholdings::item;
713 use base 'OpenILS::WWW::SuperCat::Feed::htmlcard::item';
714
715 1;