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