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;