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