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