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