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