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