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