1 package OpenILS::WWW::SuperCat;
2 use strict; use warnings;
6 use Apache2::Const -compile => qw(OK REDIRECT DECLINED :log);
7 use APR::Const -compile => qw(:error SUCCESS);
8 use Apache2::RequestRec ();
9 use Apache2::RequestIO ();
10 use Apache2::RequestUtil;
14 use OpenSRF::EX qw(:try);
15 use OpenSRF::Utils qw/:datetime/;
17 use OpenSRF::AppSession;
20 use Unicode::Normalize;
21 use OpenILS::Utils::Fieldmapper;
24 # set the bootstrap config when this module is loaded
25 my ($bootstrap, $supercat, $actor, $parser);
34 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
35 $supercat = OpenSRF::AppSession->create('open-ils.supercat');
36 $actor = OpenSRF::AppSession->create('open-ils.actor');
37 $parser = new XML::LibXML;
43 return Apache2::Const::DECLINED if (-e $apache->filename);
45 (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
48 ->request("open-ils.supercat.oisbn", $isbn)
51 print "Content-type: application/xml; charset=utf-8\n\n";
52 print "<?xml version='1.0' encoding='UTF-8' ?>\n";
54 unless (exists $$list{metarecord}) {
56 return Apache2::Const::OK;
59 print "<idlist metarecord='$$list{metarecord}'>\n";
61 for ( keys %{ $$list{record_list} } ) {
62 (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
63 print " <isbn record='$_'>$o</isbn>\n"
68 return Apache2::Const::OK;
74 return Apache2::Const::DECLINED if (-e $apache->filename);
76 print "Content-type: application/xml; charset=utf-8\n";
80 my $uri = $cgi->param('uri') || '';
82 my $host = $cgi->virtual_host || $cgi->server_name;
84 my $format = $cgi->param('format');
85 my ($id,$type,$command) = ('','','');
88 if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
91 $type = 'metarecord' if ($1 =~ /^m/o);
94 ->request("open-ils.supercat.$type.formats")
104 <type>text/html</type>
108 my ($type) = keys %$h;
109 $body .= "<format><name>$type</name><type>application/$type+xml</type>";
111 for my $part ( qw/namespace_uri docs schema_location/ ) {
112 $body .= "<$part>$$h{$type}{$part}</$part>"
113 if ($$h{$type}{$part});
116 $body .= '</format>';
119 $body .= "</formats>\n";
121 $apache->custom_response( 300, $body);
125 ->request("open-ils.supercat.record.formats")
130 ->request("open-ils.supercat.metarecord.formats")
134 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
135 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
140 <type>text/html</type>
144 my ($type) = keys %$h;
145 print "<format><name>$type</name><type>application/$type+xml</type>";
147 for my $part ( qw/namespace_uri docs schema_location/ ) {
148 print "<$part>$$h{$type}{$part}</$part>"
149 if ($$h{$type}{$part});
155 print "</formats>\n";
158 return Apache2::Const::OK;
163 if ($uri =~ m{^tag:[^:]+:([^\/]+)/(\d+)}o) {
166 $type = 'metarecord' if ($1 =~ /^m/o);
167 $command = 'retrieve';
170 if ($format eq 'opac') {
171 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
172 if ($type eq 'metarecord');
173 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
174 if ($type eq 'record');
178 print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
180 return Apache2::Const::OK;
186 return Apache2::Const::DECLINED if (-e $apache->filename);
188 my $path = $apache->path_info;
191 my $base = $cgi->url;
193 my ($id,$type,$format,$command) = reverse split '/', $path;
195 print "Content-type: application/xml; charset=utf-8\n";
197 if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
200 ->request("open-ils.supercat.$1.formats")
208 <type>text/html</type>
212 my ($type) = keys %$h;
213 print "<format><name>$type</name><type>application/$type+xml</type>";
215 for my $part ( qw/namespace_uri docs schema_location/ ) {
216 print "<$part>$$h{$type}{$part}</$part>"
217 if ($$h{$type}{$part});
223 print "</formats>\n";
225 return Apache2::Const::OK;
229 ->request("open-ils.supercat.record.formats")
234 ->request("open-ils.supercat.metarecord.formats")
238 my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
239 $list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
244 <type>text/html</type>
248 my ($type) = keys %$h;
249 print "<format><name>$type</name><type>application/$type+xml</type>";
251 for my $part ( qw/namespace_uri docs schema_location/ ) {
252 print "<$part>$$h{$type}{$part}</$part>"
253 if ($$h{$type}{$part});
259 print "</formats>\n";
262 return Apache2::Const::OK;
265 if ($format eq 'opac') {
266 print "Location: $base/../../en-US/skin/default/xml/rresult.xml?m=$id\n\n"
267 if ($type eq 'metarecord');
268 print "Location: $base/../../en-US/skin/default/xml/rdetail.xml?r=$id\n\n"
269 if ($type eq 'record');
273 print "\n" . $supercat->request("open-ils.supercat.$type.$format.$command",$id)->gather(1);
275 return Apache2::Const::OK;
281 return Apache2::Const::DECLINED if (-e $apache->filename);
283 print "Content-type: application/xml; charset=utf-8\n\n";
286 (my $unapi = $cgi->url) =~ s{[^/]+/?$}{unapi};
288 my $year = (gmtime())[5];
290 my $host = $cgi->virtual_host || $cgi->server_name;
291 my $path = $apache->path_info;
293 my ($id,$type) = reverse split '/', $path;
295 my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
296 my $bucket_tag = "tag:$host,$year:record_bucket/$id";
298 my $feed = create_record_feed(
300 [ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
304 $feed->title("Items in Book Bag #".$bucket->id);
305 $feed->creator($host);
306 $feed->update_ts(gmtime_ISO8601());
308 $feed->link(atom => $id);
309 $feed->link(rss2 => $id);
310 $feed->link(html => $id);
312 print entityize($feed->toString) . "\n";
314 return Apache2::Const::OK;
317 sub create_record_feed {
323 my $base = $cgi->url;
324 my $host = $cgi->virtual_host || $cgi->server_name;
326 my $year = (gmtime())[5];
328 my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
330 $feed->unapi($unapi);
332 for my $rec (@$records) {
333 my $item_tag = "tag:$host,$year:biblio-record_entry/" . $rec;
335 my $xml = $supercat->request(
336 "open-ils.supercat.record.$type.retrieve",
340 my $node = $feed->add_item($xml);
342 $node->id($item_tag);
343 $node->link(unapi => $item_tag);
350 my $stuff = NFC(shift());
351 $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
355 package OpenILS::WWW::SuperCat::Feed;
361 $class .= '::'.$type;
364 throw OpenSRF::EX::ERROR ("I need a feed type!") ;
371 my $self = { doc => $parser->parse_string($xml), items => [] };
373 return bless $self => $class;
379 $self->{base} = $base if ($base);
380 return $self->{base};
386 $self->{unapi} = $unapi if ($unapi);
387 return $self->{unapi};
392 push @{ $self->{items} }, @_;
397 return @{ $self->{items} } if (wantarray);
398 return $self->{items};
407 for my $node ($self->{doc}->findnodes($xpath)) {
408 $node->appendChild($new);
422 for my $node ($self->{doc}->findnodes($xpath)) {
423 my $new = $self->{doc}->createElement($name) if (!$ns);
424 $new = $self->{doc}->createElementNS($ns,$name) if ($ns);
426 $new->appendChild( $self->{doc}->createTextNode( $text ) )
430 for my $key (keys %$attrs) {
431 $new->setAttribute( $key => $$attrs{$key} );
435 $node->appendChild( $new );
443 my $class = ref($self) || $self;
446 my $item_xml = shift;
447 my $entry = $class->new($item_xml);
449 $entry->base($self->base);
450 $entry->unapi($self->unapi);
452 $self->push_item($entry);
458 for my $root ( $self->{doc}->findnodes($self->{item_xpath}) ) {
459 for my $item ( $self->items ) {
460 $root->appendChild( $item->{doc}->documentElement );
465 return $self->{doc}->toString;
474 #----------------------------------------------------------
476 package OpenILS::WWW::SuperCat::Feed::atom;
477 use base 'OpenILS::WWW::SuperCat::Feed';
481 my $self = $class->SUPER::build('<atom:feed xmlns:atom="http://www.w3.org/2005/Atom"/>');
482 $self->{type} = 'atom';
483 $self->{item_xpath} = '/atom:feed';
490 $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:title', $text);
496 $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:updated', $text);
502 $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','atom:author');
503 $self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','atom:name', $text);
513 'http://www.w3.org/2005/Atom',
517 href => $self->base . '/' . $type . '/' . $id,
518 type => "application/$type+xml",
527 $self->_create_node( '/atom:feed', 'http://www.w3.org/2005/Atom', 'atom:id', $id );
530 package OpenILS::WWW::SuperCat::Feed::atom::item;
531 use base 'OpenILS::WWW::SuperCat::Feed::atom';
536 my $self = $class->SUPER::build($xml);
537 $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
538 $self->{type} = 'atom::item';
547 if ($type eq 'unapi') {
550 'http://www.w3.org/2005/Atom',
554 type => "application/xml",
555 href => $self->unapi . '?uri=' . $id,
562 #----------------------------------------------------------
564 package OpenILS::WWW::SuperCat::Feed::rss2;
565 use base 'OpenILS::WWW::SuperCat::Feed';
569 my $self = $class->SUPER::build('<rss version="2.0"><channel/></rss>');
570 $self->{type} = 'rss2';
571 $self->{item_xpath} = '/rss/channel';
578 $self->_create_node('/rss/channel',undef,'title', $text);
584 $self->_create_node('/rss/channel',undef,'lastBuildDate', $text);
590 $self->_create_node('/rss/channel', undef,'generator', $text);
602 $self->base . '/' . $type . '/' . $id,
607 package OpenILS::WWW::SuperCat::Feed::rss2::item;
608 use base 'OpenILS::WWW::SuperCat::Feed::rss2';
613 my $self = $class->SUPER::build($xml);
614 $self->{type} = 'atom::item';
623 $self->_create_node( item => undef, 'link' => $self->unapi . '?uri=' . $id )
624 if ($type eq 'unapi');
628 #----------------------------------------------------------
630 package OpenILS::WWW::SuperCat::Feed::mods;
631 use base 'OpenILS::WWW::SuperCat::Feed';
635 my $self = $class->SUPER::build('<mods:modsCollection version="3.0" xmlns:mods="http://www.loc.gov/mods/"/>');
636 $self->{type} = 'mods';
637 $self->{item_xpath} = '/mods:modsCollection';
641 package OpenILS::WWW::SuperCat::Feed::mods::item;
642 use base 'OpenILS::WWW::SuperCat::Feed::mods';
647 my $self = $class->SUPER::build($xml);
648 $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods');
649 $self->{type} = 'mods::item';
660 if ($type eq 'unapi') {
663 'http://www.loc.gov/mods/',
666 { type => 'otherFormat', id => 'link-'.$linkid }
669 "mods:mods/mods:relatedItem[\@id='link-$linkid']",
670 'http://www.loc.gov/mods/',
671 'mods:recordIdentifier',
672 $self->unapi .'?uri=' . $id
679 #----------------------------------------------------------
681 package OpenILS::WWW::SuperCat::Feed::html;
682 use base 'OpenILS::WWW::SuperCat::Feed';
686 my $self = $class->SUPER::build('<html><head/><body/></html>');
687 $self->{type} = 'html';
688 $self->{item_xpath} = '/html/body';