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 composeDoc {
 140         my $self = shift;
 141         for my $root ( $self->{doc}->findnodes($self->{item_xpath}) ) {
 142                 for my $item ( $self->items ) {
 143                         $root->appendChild( $item->{doc}->documentElement );
 144                 }
 145                 last;
 146         }
 147 }
 148
 149 sub toString {
 150         my $self = shift;
 151         $self->composeDoc;
 152         return $self->{doc}->toString(1);
 153 }
 154
 155 sub id {};
 156 sub link {};
 157 sub title {};
 158 sub update_ts {};
 159 sub creator {};
 160
 161 #----------------------------------------------------------
 162
 163 package OpenILS::WWW::SuperCat::Feed::atom;
 164 use base 'OpenILS::WWW::SuperCat::Feed';
 165
 166 sub new {
 167         my $class = shift;
 168         my $self = $class->SUPER::build('<atom:feed xmlns:atom="http://www.w3.org/2005/Atom"/>');
 169         $self->{type} = 'application/xml';
 170         $self->{item_xpath} = '/atom:feed';
 171         return $self;
 172 }
 173
 174 sub title {
 175         my $self = shift;
 176         my $text = shift;
 177         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:title', $text);
 178 }
 179
 180 sub update_ts {
 181         my $self = shift;
 182         my $text = shift;
 183         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:updated', $text);
 184 }
 185
 186 sub creator {
 187         my $self = shift;
 188         my $text = shift;
 189         $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:author');
 190         $self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','atom:name', $text);
 191 }
 192
 193 sub link {
 194         my $self = shift;
 195         my $type = shift;
 196         my $id = shift;
 197         my $mime = shift || "application/x-$type+xml";
 198         my $title = shift;
 199
 200         $type = 'self' if ($type eq 'atom');
 201
 202         $self->_create_node(
 203                 $self->{item_xpath},
 204                 'http://www.w3.org/2005/Atom',
 205                 'atom:link',
 206                 undef,
 207                 { rel => $type,
 208                   href => $id,
 209                   title => $title,
 210                   type => $mime,
 211                 }
 212         );
 213 }
 214
 215 sub id {
 216         my $self = shift;
 217         my $id = shift;
 218
 219         $self->_create_node( '/atom:feed', 'http://www.w3.org/2005/Atom', 'atom:id', $id );
 220 }
 221
 222 package OpenILS::WWW::SuperCat::Feed::atom::item;
 223 use base 'OpenILS::WWW::SuperCat::Feed::atom';
 224
 225 sub new {
 226         my $class = shift;
 227         my $xml = shift;
 228         my $self = $class->SUPER::build($xml);
 229         $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
 230         $self->{item_xpath} = '/atom:entry';
 231         $self->{type} = 'application/xml';
 232         return $self;
 233 }
 234
 235
 236 #----------------------------------------------------------
 237
 238 package OpenILS::WWW::SuperCat::Feed::rss2;
 239 use base 'OpenILS::WWW::SuperCat::Feed';
 240
 241 sub new {
 242         my $class = shift;
 243         my $self = $class->SUPER::build('<rss version="2.0"><channel/></rss>');
 244         $self->{type} = 'application/xml';
 245         $self->{item_xpath} = '/rss/channel';
 246         return $self;
 247 }
 248
 249 sub title {
 250         my $self = shift;
 251         my $text = shift;
 252         $self->_create_node('/rss/channel',undef,'title', $text);
 253 }
 254
 255 sub update_ts {
 256         my $self = shift;
 257         my $text = shift;
 258         $self->_create_node('/rss/channel',undef,'lastBuildDate', $text);
 259 }
 260
 261 sub creator {
 262         my $self = shift;
 263         my $text = shift;
 264         $self->_create_node('/rss/channel', undef,'generator', $text);
 265 }
 266
 267 sub link {
 268         my $self = shift;
 269         my $type = shift;
 270         my $id = shift;
 271         my $mime = shift || "application/x-$type+xml";
 272
 273         $type = 'self' if ($type eq 'rss2');
 274
 275         $self->_create_node(
 276                 $self->{item_xpath},
 277                 undef,
 278                 'link',
 279                 $id,
 280                 { rel => $type,
 281                   type => $mime,
 282                 }
 283         );
 284 }
 285
 286 package OpenILS::WWW::SuperCat::Feed::rss2::item;
 287 use base 'OpenILS::WWW::SuperCat::Feed::rss2';
 288
 289 sub new {
 290         my $class = shift;
 291         my $xml = shift;
 292         my $self = $class->SUPER::build($xml);
 293         $self->{type} = 'application/xml';
 294         $self->{item_xpath} = '/item';
 295         return $self;
 296 }
 297
 298
 299 #----------------------------------------------------------
 300
 301 package OpenILS::WWW::SuperCat::Feed::mods;
 302 use base 'OpenILS::WWW::SuperCat::Feed';
 303
 304 sub new {
 305         my $class = shift;
 306         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/"/>');
 307         $self->{type} = 'application/xml';
 308         $self->{item_xpath} = '/mods:modsCollection';
 309         return $self;
 310 }
 311
 312 package OpenILS::WWW::SuperCat::Feed::mods::item;
 313 use base 'OpenILS::WWW::SuperCat::Feed::mods';
 314
 315 sub new {
 316         my $class = shift;
 317         my $xml = shift;
 318         my $self = $class->SUPER::build($xml);
 319         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods');
 320         $self->{type} = 'application/xml';
 321         return $self;
 322 }
 323
 324 my $linkid = 1;
 325
 326 sub link {
 327         my $self = shift;
 328         my $type = shift;
 329         my $id = shift;
 330
 331         if ($type eq 'unapi' || $type eq 'opac') {
 332                 $self->_create_node(
 333                         'mods:mods',
 334                         'http://www.loc.gov/mods/',
 335                         'mods:relatedItem',
 336                         undef,
 337                         { type => 'otherFormat', id => 'link-'.$linkid }
 338                 );
 339                 $self->_create_node(
 340                         "mods:mods/mods:relatedItem[\@id='link-$linkid']",
 341                         'http://www.loc.gov/mods/',
 342                         'mods:recordIdentifier',
 343                         $id
 344                 );
 345                 $linkid++;
 346         }
 347 }
 348
 349
 350 #----------------------------------------------------------
 351
 352 package OpenILS::WWW::SuperCat::Feed::mods3;
 353 use base 'OpenILS::WWW::SuperCat::Feed';
 354
 355 sub new {
 356         my $class = shift;
 357         my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/v3"/>');
 358         $self->{type} = 'application/xml';
 359         $self->{item_xpath} = '/mods:modsCollection';
 360         return $self;
 361 }
 362
 363 package OpenILS::WWW::SuperCat::Feed::mods3::item;
 364 use base 'OpenILS::WWW::SuperCat::Feed::mods3';
 365
 366 sub new {
 367         my $class = shift;
 368         my $xml = shift;
 369         my $self = $class->SUPER::build($xml);
 370         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', 'mods');
 371         $self->{type} = 'application/xml';
 372         return $self;
 373 }
 374
 375
 376 #----------------------------------------------------------
 377
 378 package OpenILS::WWW::SuperCat::Feed::marcxml;
 379 use base 'OpenILS::WWW::SuperCat::Feed';
 380
 381 sub new {
 382         my $class = shift;
 383         my $self = $class->SUPER::build('<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim"/>');
 384         $self->{type} = 'application/xml';
 385         $self->{item_xpath} = '/marc:collection';
 386         return $self;
 387 }
 388
 389 package OpenILS::WWW::SuperCat::Feed::marcxml::item;
 390 use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
 391
 392 sub new {
 393         my $class = shift;
 394         my $xml = shift;
 395         my $self = $class->SUPER::build($xml);
 396         $self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', 'marc');
 397         $self->{type} = 'application/xml';
 398         return $self;
 399 }
 400
 401 #----------------------------------------------------------
 402
 403 package OpenILS::WWW::SuperCat::Feed::html;
 404 use base 'OpenILS::WWW::SuperCat::Feed::atom';
 405
 406 sub new {
 407         my $class = shift;
 408         my $self = $class->SUPER::new;
 409         $self->type('text/html');
 410         return $self;
 411 }
 412
 413 our ($_parser, $_xslt, $xslt_file);
 414
 415 sub toString {
 416         my $self = shift;
 417         my $base = $self->base || '';
 418         my $root = $self->root || '';
 419         my $search = $self->search || '';
 420         my $lib = $self->lib || '-';
 421
 422         $self->composeDoc;
 423
 424         $_parser ||= new XML::LibXML;
 425         $_xslt ||= new XML::LibXSLT;
 426
 427         $xslt_file ||=
 428                 OpenSRF::Utils::SettingsClient
 429                         ->new
 430                         ->config_value( dirs => 'xsl' ).
 431                 "/ATOM2XHTML.xsl";
 432
 433         # parse the MODS xslt ...
 434         my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
 435
 436         my $new_doc = $atom2html_xslt->transform(
 437                 $self->{doc},
 438                 base_dir => "'$root'",
 439                 lib => "'$lib'",
 440                 searchTerms => "'$search'",
 441         );
 442
 443         return $new_doc->toStringHTML();
 444 }
 445
 446
 447 package OpenILS::WWW::SuperCat::Feed::html::item;
 448 use base 'OpenILS::WWW::SuperCat::Feed::atom::item';
 449
 450 1;