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 OpenSRF::Utils::Logger qw/$logger/;
   9 use CGI;
  10
  11 my $log = 'OpenSRF::Utils::Logger';
  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         $log->debug("Document composed");
 219         return $self->{doc}->toString(1);
 220 }
 221
 222 sub id {};
 223 sub link {};
 224 sub title {};
 225 sub update_ts {};
 226 sub creator {};
 227
 228 #----------------------------------------------------------
 229
 230 package OpenILS::WWW::SuperCat::Feed::atom;
 231 use base 'OpenILS::WWW::SuperCat::Feed';
 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/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         my $text = shift;
 252         $self->_create_node($self->{item_xpath},'http://www.w3.org/2005/Atom','updated', $text);
 253 }
 254
 255 sub creator {
 256         my $self = shift;
 257         my $text = shift;
 258         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','author');
 259         $self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','name', $text);
 260 }
 261
 262 sub link {
 263         my $self = shift;
 264         my $type = shift;
 265         my $id = shift;
 266         my $mime = shift || "application/x-$type+xml";
 267         my $title = shift;
 268
 269         $type = 'self' if ($type eq 'atom');
 270
 271         $self->_create_node(
 272                 $self->{item_xpath},
 273                 'http://www.w3.org/2005/Atom',
 274                 'link',
 275                 undef,
 276                 { rel => $type,
 277                   href => $id,
 278                   title => $title,
 279                   type => $mime,
 280                 }
 281         );
 282 }
 283
 284 sub id {
 285         my $self = shift;
 286         my $id = shift;
 287
 288         $self->_create_node( '/atom:feed', 'http://www.w3.org/2005/Atom', 'id', $id );
 289 }
 290
 291 package OpenILS::WWW::SuperCat::Feed::atom::item;
 292 use base 'OpenILS::WWW::SuperCat::Feed::atom';
 293
 294 sub new {
 295         my $class = shift;
 296         my $xml = shift;
 297         my $self = $class->SUPER::build($xml);
 298         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef);
 299         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
 300         $self->{item_xpath} = '/atom:entry';
 301         $self->{holdings_xpath} = '/atom:entry';
 302         $self->{type} = 'application/xml';
 303         return $self;
 304 }
 305
 306
 307 #----------------------------------------------------------
 308
 309 package OpenILS::WWW::SuperCat::Feed::rss2;
 310 use base 'OpenILS::WWW::SuperCat::Feed';
 311
 312 sub new {
 313         my $class = shift;
 314         my $self = $class->SUPER::build('<rss version="2.0"><channel/></rss>');
 315         $self->{type} = 'application/xml';
 316         $self->{item_xpath} = '/rss/channel';
 317         return $self;
 318 }
 319
 320 sub title {
 321         my $self = shift;
 322         my $text = shift;
 323         $self->_create_node('/rss/channel',undef,'title', $text);
 324 }
 325
 326 sub update_ts {
 327         my $self = shift;
 328         my $text = shift;
 329         $self->_create_node($self->{item_xpath},undef,'lastBuildDate', $text);
 330 }
 331
 332 sub creator {
 333         my $self = shift;
 334         my $text = shift;
 335         $self->_create_node('/rss/channel', undef,'generator', $text);
 336 }
 337
 338 sub link {
 339         my $self = shift;
 340         my $type = shift;
 341         my $id = shift;
 342         my $mime = shift || "application/x-$type+xml";
 343
 344         $type = 'self' if ($type eq 'rss2');
 345
 346         $self->_create_node(
 347                 $self->{item_xpath},
 348                 undef,
 349                 'link',
 350                 $id,
 351                 { rel => $type,
 352                   type => $mime,
 353                 }
 354         );
 355 }
 356
 357 package OpenILS::WWW::SuperCat::Feed::rss2::item;
 358 use base 'OpenILS::WWW::SuperCat::Feed::rss2';
 359
 360 sub new {
 361         my $class = shift;
 362         my $xml = shift;
 363         my $self = $class->SUPER::build($xml);
 364         $self->{type} = 'application/xml';
 365         $self->{item_xpath} = '/item';
 366         $self->{holdings_xpath} = '/item';
 367         return $self;
 368 }
 369
 370 sub update_ts {
 371         my $self = shift;
 372         my $text = shift;
 373         $self->_create_node($self->{item_xpath},undef,'pubDate', $text);
 374 }
 375
 376
 377
 378 #----------------------------------------------------------
 379
 380 package OpenILS::WWW::SuperCat::Feed::mods;
 381 use base 'OpenILS::WWW::SuperCat::Feed';
 382
 383 sub new {
 384         my $class = shift;
 385         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/"/>');
 386         $self->{type} = 'application/xml';
 387         $self->{item_xpath} = '/mods:modsCollection';
 388         return $self;
 389 }
 390
 391 package OpenILS::WWW::SuperCat::Feed::mods::item;
 392 use base 'OpenILS::WWW::SuperCat::Feed::mods';
 393
 394 sub new {
 395         my $class = shift;
 396         my $xml = shift;
 397         my $self = $class->SUPER::build($xml);
 398         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', undef);
 399         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods');
 400         $self->{type} = 'application/xml';
 401         $self->{holdings_xpath} = '/mods:mods';
 402         return $self;
 403 }
 404
 405 my $linkid = 1;
 406
 407 sub link {
 408         my $self = shift;
 409         my $type = shift;
 410         my $id = shift;
 411
 412         if ($type eq 'unapi' || $type eq 'opac') {
 413                 $self->_create_node(
 414                         'mods:mods',
 415                         'http://www.loc.gov/mods/',
 416                         'mods:relatedItem',
 417                         undef,
 418                         { type => 'otherFormat', id => 'link-'.$linkid }
 419                 );
 420                 $self->_create_node(
 421                         "mods:mods/mods:relatedItem[\@id='link-$linkid']",
 422                         'http://www.loc.gov/mods/',
 423                         'mods:recordIdentifier',
 424                         $id
 425                 );
 426                 $linkid++;
 427         }
 428 }
 429
 430
 431 #----------------------------------------------------------
 432
 433 package OpenILS::WWW::SuperCat::Feed::mods3;
 434 use base 'OpenILS::WWW::SuperCat::Feed::mods';
 435
 436 sub new {
 437         my $class = shift;
 438         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/v3"/>');
 439         $self->{type} = 'application/xml';
 440         $self->{item_xpath} = '/mods:modsCollection';
 441         return $self;
 442 }
 443
 444 package OpenILS::WWW::SuperCat::Feed::mods3::item;
 445 use base 'OpenILS::WWW::SuperCat::Feed::mods::item';
 446
 447 sub new {
 448         my $class = shift;
 449         my $xml = shift;
 450         my $self = $class->SUPER::build($xml);
 451         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', undef);
 452         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', 'mods');
 453         $self->{type} = 'application/xml';
 454         $self->{holdings_xpath} = '/mods:mods';
 455         return $self;
 456 }
 457
 458 sub link {
 459         my $self = shift;
 460         my $type = shift;
 461         my $id = shift;
 462
 463         if ($type eq 'unapi' || $type eq 'opac') {
 464                 $self->_create_node(
 465                         'mods:mods',
 466                         'http://www.loc.gov/mods/v3',
 467                         'mods:relatedItem',
 468                         undef,
 469                         { type => 'otherFormat', id => 'link-'.$linkid }
 470                 );
 471                 $self->_create_node(
 472                         "mods:mods/mods:relatedItem[\@id='link-$linkid']",
 473                         'http://www.loc.gov/mods/v3',
 474                         'mods:recordIdentifier',
 475                         $id
 476                 );
 477                 $linkid++;
 478         }
 479 }
 480
 481
 482 #----------------------------------------------------------
 483
 484 package OpenILS::WWW::SuperCat::Feed::marcxml;
 485 use base 'OpenILS::WWW::SuperCat::Feed';
 486
 487 sub new {
 488         my $class = shift;
 489         my $self = $class->SUPER::build('<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim"/>');
 490         $self->{type} = 'application/xml';
 491         $self->{item_xpath} = '/marc:collection';
 492         return $self;
 493 }
 494 sub link {
 495         my $self = shift;
 496         my $type = shift;
 497         my $id = shift;
 498
 499         if ($type eq 'unapi') {
 500                 $self->_create_node(
 501                         'marc:collection',
 502                         'http://www.w3.org/1999/xhtml',
 503                         'xhtml:link',
 504                         undef,
 505                         { rel => 'unapi-server', href => $id, title => "unapi" }
 506                 );
 507                 $linkid++;
 508         }
 509 }
 510
 511
 512 package OpenILS::WWW::SuperCat::Feed::marcxml::item;
 513 use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
 514
 515 sub new {
 516         my $class = shift;
 517         my $xml = shift;
 518         my $self = $class->SUPER::build($xml);
 519         return undef unless $self;
 520         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', undef);
 521         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', 'marc');
 522         $self->{type} = 'application/xml';
 523         $self->{holdings_xpath} = '/marc:record';
 524         return $self;
 525 }
 526
 527 sub link {
 528         my $self = shift;
 529         my $type = shift;
 530         my $id = shift;
 531
 532         if ($type eq 'opac') {
 533                 $self->_create_node(
 534                         'marc:record',
 535                         'http://www.w3.org/1999/xhtml',
 536                         'xhtml:link',
 537                         undef,
 538                         { rel => 'otherFormat', href => $id, title => "Dynamic Details" }
 539                 );
 540                 $linkid++;
 541         } elsif ($type eq 'unapi-id') {
 542                 $self->_create_node(
 543                         'marc:record',
 544                         'http://www.w3.org/1999/xhtml',
 545                         'xhtml:abbr',
 546                         undef,
 547                         {  title => $id, class => "unapi-id" }
 548                 );
 549                 $linkid++;
 550         }
 551 }
 552
 553
 554 #----------------------------------------------------------
 555
 556 package OpenILS::WWW::SuperCat::Feed::html;
 557 use base 'OpenILS::WWW::SuperCat::Feed::atom';
 558
 559 sub new {
 560         my $class = shift;
 561         my $self = $class->SUPER::new;
 562         $self->type('text/html');
 563         return $self;
 564 }
 565
 566 our ($_parser, $_xslt, $xslt_file);
 567
 568 sub toString {
 569         my $self = shift;
 570         my $base = $self->base || '';
 571         my $root = $self->root || '';
 572         my $search = $self->search || '';
 573         my $class = $self->class || '';
 574         my $lib = $self->lib || '-';
 575
 576         $self->composeDoc;
 577
 578         $_parser ||= new XML::LibXML;
 579         $_xslt ||= new XML::LibXSLT;
 580
 581         $xslt_file ||=
 582                 OpenSRF::Utils::SettingsClient
 583                         ->new
 584                         ->config_value( dirs => 'xsl' ).
 585                 "/ATOM2XHTML.xsl";
 586
 587         # parse the MODS xslt ...
 588         my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
 589
 590         my $new_doc = $atom2html_xslt->transform(
 591                 $self->{doc},
 592                 base_dir => "'$root'",
 593                 lib => "'$lib'",
 594                 searchTerms => "'$search'",
 595                 searchClass => "'$class'",
 596         );
 597
 598         return $new_doc->toString(1);
 599 }
 600
 601
 602 package OpenILS::WWW::SuperCat::Feed::html::item;
 603 use base 'OpenILS::WWW::SuperCat::Feed::atom::item';
 604
 605 #----------------------------------------------------------
 606
 607 package OpenILS::WWW::SuperCat::Feed::htmlcard;
 608 use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
 609
 610 sub new {
 611         my $class = shift;
 612         my $self = $class->SUPER::new;
 613         $self->type('text/html');
 614         $self->{xsl} = "/MARC21slim2HTMLCard.xsl";
 615         return $self;
 616 }
 617
 618 our ($_parser, $_xslt, $xslt_file);
 619
 620 sub toString {
 621         my $self = shift;
 622         my $base = $self->base || '';
 623         my $root = $self->root || '';
 624         my $search = $self->search || '';
 625         my $sort = $self->Sort || '';
 626         my $sort_dir = $self->SortDir || '';
 627         my $lang = $self->lang || '';
 628         my $lib = $self->lib || '-';
 629
 630         $self->composeDoc;
 631
 632         $_parser ||= new XML::LibXML;
 633         $_xslt ||= new XML::LibXSLT;
 634
 635         $xslt_file =
 636                 OpenSRF::Utils::SettingsClient
 637                         ->new
 638                         ->config_value( dirs => 'xsl' ).$self->{xsl};
 639
 640         # parse the MODS xslt ...
 641         my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
 642
 643         my $new_doc = $atom2html_xslt->transform(
 644                 $self->{doc},
 645                 base_dir => "'$root'",
 646                 lib => "'$lib'",
 647                 searchTerms => "'$search'",
 648                 searchSort => "'$sort'",
 649                 searchSortDir => "'$sort_dir'",
 650                 searchLang => "'$lang'",
 651         );
 652
 653         return $new_doc->toString(1);
 654 }
 655
 656 package OpenILS::WWW::SuperCat::Feed::htmlcard::item;
 657 use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item';
 658
 659 package OpenILS::WWW::SuperCat::Feed::htmlholdings;
 660 use base 'OpenILS::WWW::SuperCat::Feed::htmlcard';
 661
 662 sub new {
 663         my $class = shift;
 664         my $self = $class->SUPER::new;
 665         $self->{xsl} = "/MARC21slim2HTMLCard-holdings.xsl";
 666         return $self;
 667 }
 668
 669 package OpenILS::WWW::SuperCat::Feed::htmlholdings::item;
 670 use base 'OpenILS::WWW::SuperCat::Feed::htmlcard::item';
 671
 672 1;