]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/OpenILS/Application/SuperCat.pm
130c2734bfb3d70f1264fb2aaaa04141f2182142
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / SuperCat.pm
1 package OpenILS::Application::SuperCat;
2
3 use strict;
4 use warnings;
5
6 # All OpenSRF applications must be based on OpenSRF::Application or
7 # a subclass thereof.  Makes sense, eh?
8 use OpenSRF::Application;
9 use base qw/OpenSRF::Application/;
10
11 # This is the client class, used for connecting to open-ils.storage
12 use OpenSRF::AppSession;
13
14 # This is an extention of Error.pm that supplies some error types to throw
15 use OpenSRF::EX qw(:try);
16
17 # This is a helper class for querying the OpenSRF Settings application ...
18 use OpenSRF::Utils::SettingsClient;
19
20 # ... and here we have the built in logging helper ...
21 use OpenSRF::Utils::Logger qw($logger);
22
23 # ... and this is our OpenILS object (en|de)coder and psuedo-ORM package.
24 use OpenILS::Utils::Fieldmapper;
25
26
27 # We'll be working with XML, so...
28 use XML::LibXML;
29 use XML::LibXSLT;
30 use Unicode::Normalize;
31
32 use JSON;
33
34 our (
35   $_parser,
36   $_xslt,
37   %record_xslt,
38   %metarecord_xslt,
39   %holdings_data_cache,
40 );
41
42 sub child_init {
43         # we need an XML parser
44         $_parser = new XML::LibXML;
45
46         # and an xslt parser
47         $_xslt = new XML::LibXSLT;
48         
49         # parse the MODS xslt ...
50         my $mods3_xslt = $_parser->parse_file(
51                 OpenSRF::Utils::SettingsClient
52                         ->new
53                         ->config_value( dirs => 'xsl' ).
54                 "/MARC21slim2MODS3.xsl"
55         );
56         # and stash a transformer
57         $record_xslt{mods3}{xslt} = $_xslt->parse_stylesheet( $mods3_xslt );
58         $record_xslt{mods3}{namespace_uri} = 'http://www.loc.gov/mods/v3';
59         $record_xslt{mods3}{docs} = 'http://www.loc.gov/mods/';
60         $record_xslt{mods3}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-1.xsd';
61
62         # parse the MODS xslt ...
63         my $mods_xslt = $_parser->parse_file(
64                 OpenSRF::Utils::SettingsClient
65                         ->new
66                         ->config_value( dirs => 'xsl' ).
67                 "/MARC21slim2MODS.xsl"
68         );
69         # and stash a transformer
70         $record_xslt{mods}{xslt} = $_xslt->parse_stylesheet( $mods_xslt );
71         $record_xslt{mods}{namespace_uri} = 'http://www.loc.gov/mods/';
72         $record_xslt{mods}{docs} = 'http://www.loc.gov/mods/';
73         $record_xslt{mods}{schema_location} = 'http://www.loc.gov/standards/mods/mods.xsd';
74
75         # parse the ATOM entry xslt ...
76         my $atom_xslt = $_parser->parse_file(
77                 OpenSRF::Utils::SettingsClient
78                         ->new
79                         ->config_value( dirs => 'xsl' ).
80                 "/MARC21slim2ATOM.xsl"
81         );
82         # and stash a transformer
83         $record_xslt{atom}{xslt} = $_xslt->parse_stylesheet( $atom_xslt );
84         $record_xslt{atom}{namespace_uri} = 'http://www.w3.org/2005/Atom';
85         $record_xslt{atom}{docs} = 'http://www.ietf.org/rfc/rfc4287.txt';
86
87         # parse the RDFDC xslt ...
88         my $rdf_dc_xslt = $_parser->parse_file(
89                 OpenSRF::Utils::SettingsClient
90                         ->new
91                         ->config_value( dirs => 'xsl' ).
92                 "/MARC21slim2RDFDC.xsl"
93         );
94         # and stash a transformer
95         $record_xslt{rdf_dc}{xslt} = $_xslt->parse_stylesheet( $rdf_dc_xslt );
96         $record_xslt{rdf_dc}{namespace_uri} = 'http://purl.org/dc/elements/1.1/';
97         $record_xslt{rdf_dc}{schema_location} = 'http://purl.org/dc/elements/1.1/';
98
99         # parse the SRWDC xslt ...
100         my $srw_dc_xslt = $_parser->parse_file(
101                 OpenSRF::Utils::SettingsClient
102                         ->new
103                         ->config_value( dirs => 'xsl' ).
104                 "/MARC21slim2SRWDC.xsl"
105         );
106         # and stash a transformer
107         $record_xslt{srw_dc}{xslt} = $_xslt->parse_stylesheet( $srw_dc_xslt );
108         $record_xslt{srw_dc}{namespace_uri} = 'info:srw/schema/1/dc-schema';
109         $record_xslt{srw_dc}{schema_location} = 'http://www.loc.gov/z3950/agency/zing/srw/dc-schema.xsd';
110
111         # parse the OAIDC xslt ...
112         my $oai_dc_xslt = $_parser->parse_file(
113                 OpenSRF::Utils::SettingsClient
114                         ->new
115                         ->config_value( dirs => 'xsl' ).
116                 "/MARC21slim2OAIDC.xsl"
117         );
118         # and stash a transformer
119         $record_xslt{oai_dc}{xslt} = $_xslt->parse_stylesheet( $oai_dc_xslt );
120         $record_xslt{oai_dc}{namespace_uri} = 'http://www.openarchives.org/OAI/2.0/oai_dc/';
121         $record_xslt{oai_dc}{schema_location} = 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd';
122
123         # parse the RSS xslt ...
124         my $rss_xslt = $_parser->parse_file(
125                 OpenSRF::Utils::SettingsClient
126                         ->new
127                         ->config_value( dirs => 'xsl' ).
128                 "/MARC21slim2RSS2.xsl"
129         );
130         # and stash a transformer
131         $record_xslt{rss2}{xslt} = $_xslt->parse_stylesheet( $rss_xslt );
132
133         register_record_transforms();
134
135         return 1;
136 }
137
138 sub register_record_transforms {
139         for my $type ( keys %record_xslt ) {
140                 __PACKAGE__->register_method(
141                         method    => 'retrieve_record_transform',
142                         api_name  => "open-ils.supercat.record.$type.retrieve",
143                         api_level => 1,
144                         argc      => 1,
145                         signature =>
146                                 { desc     => "Returns the \U$type\E representation ".
147                                               "of the requested bibliographic record",
148                                   params   =>
149                                         [
150                                                 { name => 'bibId',
151                                                   desc => 'An OpenILS biblio::record_entry id',
152                                                   type => 'number' },
153                                         ],
154                                 'return' =>
155                                         { desc => "The bib record in \U$type\E",
156                                           type => 'string' }
157                                 }
158                 );
159         }
160 }
161
162
163 sub entityize {
164         my $stuff = NFC(shift());
165         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
166         return $stuff;
167 }
168
169 sub tree_walker {
170         my $tree = shift;
171         my $field = shift;
172         my $filter = shift;
173
174         my @things = $filter->($tree);
175         for my $v ( @{$tree->$field} ){
176                 push @things, $filter->($v);
177                 push @things, tree_walker($v, $field, $filter);
178         }
179         return @things
180 }
181
182 sub cn_browse {
183         my $self = shift;
184         my $client = shift;
185
186         my $label = shift;
187         my $ou = shift;
188         my $page_size = shift || 9;
189         my $page = shift || 0;
190
191         my ($before_limit,$after_limit) = (0,0);
192         my ($before_offset,$after_offset) = (0,0);
193
194         if (!$page) {
195                 $before_limit = $after_limit = int($page_size / 2);
196                 $after_limit += 1 if ($page_size % 2);
197         } else {
198                 $before_offset = $after_offset = int($page_size / 2);
199                 $before_offset += 1 if ($page_size % 2);
200                 $before_limit = $after_limit = $page_size;
201         }
202
203         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
204
205         my $o_search = { shortname => $ou };
206         if (!$ou || $ou eq '-') {
207                 $o_search = { parent_ou => undef };
208         }
209
210         my $orgs = $_storage->request(
211                 "open-ils.cstore.direct.actor.org_unit.search",
212                 $o_search,
213                 { flesh         => 3,
214                   flesh_fields  => { aou        => [qw/children/] }
215                 }
216         )->gather(1);
217
218         my @ou_ids = tree_walker($orgs, 'children', sub {shift->id});
219
220         $logger->debug("Searching for CNs at orgs [".join(',',@ou_ids)."], based on $ou");
221
222         my @list = ();
223
224         if ($page <= 0) {
225                 my $before = $_storage->request(
226                         "open-ils.cstore.direct.asset.call_number.search.atomic",
227                         { label         => { "<" => { transform => "upper", value => ["upper", $label] } },
228                           owning_lib    => \@ou_ids,
229                         },
230                         { flesh         => 1,
231                           flesh_fields  => { acn => [qw/record owning_lib/] },
232                           order_by      => { acn => "upper(label) desc, id desc, owning_lib desc" },
233                           limit         => $before_limit,
234                           offset        => abs($page) * $page_size - $before_offset,
235                         }
236                 )->gather(1);
237                 push @list, reverse(@$before);
238         }
239
240         if ($page >= 0) {
241                 my $after = $_storage->request(
242                         "open-ils.cstore.direct.asset.call_number.search.atomic",
243                         { label         => { ">=" => { transform => "upper", value => ["upper", $label] } },
244                           owning_lib    => \@ou_ids,
245                         },
246                         { flesh         => 1,
247                           flesh_fields  => { acn => [qw/record owning_lib/] },
248                           order_by      => { acn => "upper(label), id, owning_lib" },
249                           limit         => $after_limit,
250                           offset        => abs($page) * $page_size - $after_offset,
251                         }
252                 )->gather(1);
253                 push @list, @$after;
254         }
255
256         return \@list;
257 }
258 __PACKAGE__->register_method(
259         method    => 'cn_browse',
260         api_name  => 'open-ils.supercat.call_number.browse',
261         api_level => 1,
262         argc      => 1,
263         signature =>
264                 { desc     => <<"                 DESC",
265 Returns the XML representation of the requested bibliographic record's holdings
266                   DESC
267                   params   =>
268                         [
269                                 { name => 'label',
270                                   desc => 'The target call number lable',
271                                   type => 'string' },
272                                 { name => 'org_unit',
273                                   desc => 'The org unit shortname (or "-" or undef for global) to browse',
274                                   type => 'string' },
275                                 { name => 'page_size',
276                                   desc => 'Count of call numbers to retrieve, default is 9',
277                                   type => 'number' },
278                                 { name => 'page',
279                                   desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
280                                   type => 'number' },
281                         ],
282                   'return' =>
283                         { desc => 'Call numbers with owning_lib and record fleshed',
284                           type => 'array' }
285                 }
286 );
287
288
289 sub new_record_holdings {
290         my $self = shift;
291         my $client = shift;
292         my $bib = shift;
293         my $ou = shift;
294
295         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
296
297         my $tree = $_storage->request(
298                 "open-ils.cstore.direct.biblio.record_entry.retrieve",
299                 $bib,
300                 { flesh         => 5,
301                   flesh_fields  => {
302                                         bre     => [qw/call_numbers/],
303                                         acn     => [qw/copies owning_lib/],
304                                         acp     => [qw/location status circ_lib stat_cat_entries notes/],
305                                         asce    => [qw/stat_cat/],
306                                 }
307                 }
308         )->gather(1);
309
310         my $o_search = { shortname => $ou };
311         if (!$ou || $ou eq '-') {
312                 $o_search = { parent_ou => undef };
313         }
314
315         my $orgs = $_storage->request(
316                 "open-ils.cstore.direct.actor.org_unit.search",
317                 $o_search,
318                 { flesh         => 3,
319                   flesh_fields  => { aou        => [qw/children/] }
320                 }
321         )->gather(1);
322
323         my @ou_ids = tree_walker($orgs, 'children', sub {shift->id});
324
325         $logger->debug("Searching for holdings at orgs [".join(',',@ou_ids)."], based on $ou");
326
327         my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
328         $year += 1900;
329         $month += 1;
330
331         my $xml = "<hold:volumes xmlns:hold='http://open-ils.org/spec/holdings/v1'>";
332
333         for my $cn (@{$tree->call_numbers}) {
334
335                 my $found = 0;
336                 for my $c (@{$cn->copies}) {
337                         next unless grep {$c->circ_lib->id == $_} @ou_ids;
338                         $found = 1;
339                 }
340                 next unless $found;
341
342                 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
343                 $cn_class =~ s/Fieldmapper-//gso;
344                 my $cn_tag = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:$cn_class/".$cn->id, $month, $day);
345
346                 my $cn_lib = $cn->owning_lib->shortname;
347
348                 my $cn_label = $cn->label;
349
350                 $xml .= "<hold:volume id='$cn_tag' lib='$cn_lib' label='$cn_label'><hold:copies>";
351                 
352                 for my $cp (@{$cn->copies}) {
353
354                         next unless grep { $cp->circ_lib->id == $_ } @ou_ids;
355
356                         (my $cp_class = $cp->class_name) =~ s/::/-/gso;
357                         $cp_class =~ s/Fieldmapper-//gso;
358                         my $cp_tag = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:$cp_class/".$cp->id, $month, $day);
359
360                         my $cp_stat = $cp->status->name;
361
362                         my $cp_loc = $cp->location->name;
363
364                         my $cp_lib = $cp->circ_lib->shortname;
365
366                         my $cp_bc = $cp->barcode;
367
368                         $xml .= "<hold:copy id='$cp_tag' barcode='$cp_bc'><hold:status>$cp_stat</hold:status>".
369                                 "<hold:location>$cp_loc</hold:location><hold:circlib>$cp_lib</hold:circlib><hold:notes>";
370
371                         #if ($cp->notes) {
372                         #       for my $note ( @{$cp->notes} ) {
373                         #               next unless ( $sce->stat_cat->pub eq 't' );
374                         #               $xml .= sprintf('<hold:note date="%s" title="%s">%s</hold:note>',$note->create_date, escape($note->title), escape($note->value));
375                         #       }
376                         #}
377
378                         $xml .= "</hold:notes><hold:statcats>";
379
380                         if ($cp->stat_cat_entries) {
381                                 for my $sce ( @{$cp->stat_cat_entries} ) {
382                                         next unless ( $sce->stat_cat->opac_visible eq 't' );
383                                         $xml .= sprintf('<hold:statcat name="%s">%s</hold:statcat>',escape($sce->stat_cat->name) ,escape($sce->value));
384                                 }
385                         }
386
387                         $xml .= "</hold:statcats></hold:copy>";
388                 }
389                 
390                 $xml .= "</hold:copies></hold:volume>";
391         }
392
393         $xml .= "</hold:volumes>";
394
395         return $xml;
396 }
397 __PACKAGE__->register_method(
398         method    => 'new_record_holdings',
399         api_name  => 'open-ils.supercat.record.holdings_xml.retrieve',
400         api_level => 1,
401         argc      => 1,
402         signature =>
403                 { desc     => <<"                 DESC",
404 Returns the XML representation of the requested bibliographic record's holdings
405                   DESC
406                   params   =>
407                         [
408                                 { name => 'bibId',
409                                   desc => 'An OpenILS biblio::record_entry id',
410                                   type => 'number' },
411                         ],
412                   'return' =>
413                         { desc => 'The bib record holdings hierarchy in XML',
414                           type => 'string' }
415                 }
416 );
417
418
419
420 sub record_holdings {
421         my $self = shift;
422         my $client = shift;
423         my $bib = shift;
424
425         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
426
427         if (!$holdings_data_cache{status}) {
428                 $holdings_data_cache{status} = {
429                         map { ($_->id => $_) } @{ $_storage->request( "open-ils.cstore.direct.config.copy_status.search.atomic", {id => {'<>' => undef}} )->gather(1) }
430                 };
431                 $holdings_data_cache{location} = {
432                         map { ($_->id => $_) } @{ $_storage->request( "open-ils.cstore.direct.asset.copy_location.retrieve.all.atomic", {id => {'<>' => undef}} )->gather(1) }
433                 };
434                 $holdings_data_cache{ou} =
435                 {
436                         map {
437                                 ($_->id => $_)
438                         } @{$_storage->request( "open-ils.cstore.direct.actor.org_unit.search.atomic" => { id => { '<>' => undef } } )->gather(1)}
439                 };
440                 $holdings_data_cache{statcat} =
441                 {
442                         map {
443                                 ($_->id => $_)
444                         } @{$_storage->request( "open-ils.cstore.direct.asset.stat_cat_entry.search.atomic" => { id => { '<>' => undef } } )->gather(1)}
445                 };
446         }
447
448
449         my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
450         $year += 1900;
451         $month += 1;
452
453         my $xml = "<volumes xmlns='http://open-ils.org/spec/holdings/v1'>";
454         
455         for my $cn ( @{$_storage->request( "open-ils.cstore.direct.asset.call_number.search.atomic" => {record => $bib} )->gather(1)} ) {
456                 (my $cn_class = $cn->class_name) =~ s/::/-/gso;
457                 $cn_class =~ s/Fieldmapper-//gso;
458                 my $cn_tag = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:$cn_class/".$cn->id, $month, $day);
459
460                 my $cn_lib = $holdings_data_cache{ou}{$cn->owning_lib}->shortname;
461
462                 my $cn_label = $cn->label;
463
464                 $xml .= "<volume id='$cn_tag' lib='$cn_lib' label='$cn_label'><copies>";
465                 
466                 for my $cp ( @{$_storage->request( "open-ils.cstore.direct.asset.copy.search.atomic" => {call_number => $cn->id} )->gather(1)} ) {
467                         (my $cp_class = $cn->class_name) =~ s/::/-/gso;
468                         $cp_class =~ s/Fieldmapper-//gso;
469                         my $cp_tag = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:$cp_class/".$cp->id, $month, $day);
470
471                         my $cp_stat = $holdings_data_cache{status}{$cp->status}->name;
472
473                         my $cp_loc = $holdings_data_cache{location}{$cp->location}->name;
474
475                         my $cp_lib = $holdings_data_cache{ou}{$cp->circ_lib}->shortname;
476
477                         my $cp_bc = $cp->barcode;
478
479                         $xml .= "<copy id='$cp_tag' barcode='$cp_bc'><status>$cp_stat</status><location>$cp_loc</location><circlib>$cp_lib</circlib><notes>";
480
481                         for my $note ( @{$_storage->request( "open-ils.cstore.direct.asset.copy_note.search.atomic" => {id => $cp->id, pub => "t" })->gather(1)} ) {
482                                 $xml .= sprintf('<note date="%s" title="%s">%s</note>',$note->create_date, escape($note->title), escape($note->value));
483                         }
484
485                         $xml .= "</notes><statcats>";
486
487                         for my $sce ( @{$_storage->request( "open-ils.cstore.direct.asset.stat_cat_entry_copy_map.search.atomic" => { owning_copy => $cp->id })->gather(1)} ) {
488                                 my $sc = $holdings_data_cache{statcat}{$sce->stat_cat_entry};
489                                 $xml .= sprintf('<statcat>%s</statcat>',escape($sc->value));
490                         }
491
492                         $xml .= "</statcats></copy>";
493                 }
494                 
495                 $xml .= "</volume>";
496         }
497
498         $xml .= "</volumes>";
499
500         return $xml;
501 }
502
503 sub escape {
504         my $text = shift;
505         $text =~ s/&/&amp;/gsom;
506         $text =~ s/</&lt;/gsom;
507         $text =~ s/>/&gt;/gsom;
508         $text =~ s/"/\\"/gsom;
509         return $text;
510 }
511
512 sub recent_changes {
513         my $self = shift;
514         my $client = shift;
515         my $when = shift || '1-01-01';
516         my $limit = shift;
517
518         my $type = 'biblio';
519         $type = 'authority' if ($self->api_name =~ /authority/o);
520
521         my $axis = 'create_date';
522         $axis = 'edit_date' if ($self->api_name =~ /edit/o);
523
524         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
525
526         return $_storage
527                 ->request(
528                         "open-ils.cstore.direct.$type.record_entry.id_list.atomic",
529                         { $axis => { ">" => $when }, id => { '>' => 0 } },
530                         { order_by => "$axis desc", limit => $limit } )
531                 ->gather(1);
532 }
533
534 for my $t ( qw/biblio authority/ ) {
535         for my $a ( qw/import edit/ ) {
536
537                 __PACKAGE__->register_method(
538                         method    => 'recent_changes',
539                         api_name  => "open-ils.supercat.$t.record.$a.recent",
540                         api_level => 1,
541                         argc      => 0,
542                         signature =>
543                                 { desc     => "Returns a list of recently ${a}ed $t records",
544                                   params   =>
545                                         [
546                                                 { name => 'when',
547                                                   desc => "Date to start looking for ${a}ed records",
548                                                   default => 'today',
549                                                   type => 'string' },
550
551                                                 { name => 'limit',
552                                                   desc => "Maximum count to retrieve",
553                                                   type => 'number' },
554                                         ],
555                                   'return' =>
556                                         { desc => "An id list of $t records",
557                                           type => 'array' }
558                                 },
559                 );
560         }
561 }
562
563
564 sub retrieve_record_marcxml {
565         my $self = shift;
566         my $client = shift;
567         my $rid = shift;
568
569         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
570
571         return
572         entityize(
573                 $_storage
574                         ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rid )
575                         ->gather(1)
576                         ->marc
577         );
578 }
579
580 __PACKAGE__->register_method(
581         method    => 'retrieve_record_marcxml',
582         api_name  => 'open-ils.supercat.record.marcxml.retrieve',
583         api_level => 1,
584         argc      => 1,
585         signature =>
586                 { desc     => <<"                 DESC",
587 Returns the MARCXML representation of the requested bibliographic record
588                   DESC
589                   params   =>
590                         [
591                                 { name => 'bibId',
592                                   desc => 'An OpenILS biblio::record_entry id',
593                                   type => 'number' },
594                         ],
595                   'return' =>
596                         { desc => 'The bib record in MARCXML',
597                           type => 'string' }
598                 }
599 );
600
601 sub retrieve_record_transform {
602         my $self = shift;
603         my $client = shift;
604         my $rid = shift;
605
606         (my $transform = $self->api_name) =~ s/^.+record\.([^\.]+)\.retrieve$/$1/o;
607
608         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
609         $_storage->connect;
610
611         warn "Fetching record entry $rid\n";
612         my $marc = $_storage->request(
613                 'open-ils.cstore.direct.biblio.record_entry.retrieve',
614                 $rid
615         )->gather(1)->marc;
616         warn "Fetched record entry $rid\n";
617
618         $_storage->disconnect;
619
620         return entityize($record_xslt{$transform}{xslt}->transform( $_parser->parse_string( $marc ) )->toString);
621 }
622
623
624 sub retrieve_metarecord_mods {
625         my $self = shift;
626         my $client = shift;
627         my $rid = shift;
628
629         my $_storage = OpenSRF::AppSession->connect( 'open-ils.cstore' );
630
631         # Get the metarecord in question
632         my $mr =
633         $_storage->request(
634                 'open-ils.cstore.direct.metabib.metarecord.retrieve' => $rid
635         )->gather(1);
636
637         # Now get the map of all bib records for the metarecord
638         my $recs =
639         $_storage->request(
640                 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
641                 {metarecord => $rid}
642         )->gather(1);
643
644         $logger->debug("Adding ".scalar(@$recs)." bib record to the MODS of the metarecord");
645
646         # and retrieve the lead (master) record as MODS
647         my ($master) =
648                 $self   ->method_lookup('open-ils.supercat.record.mods.retrieve')
649                         ->run($mr->master_record);
650         my $master_mods = $_parser->parse_string($master)->documentElement;
651         $master_mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
652
653         # ... and a MODS clone to populate, with guts removed.
654         my $mods = $_parser->parse_string($master)->documentElement;
655         $mods->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
656         ($mods) = $mods->findnodes('//mods:mods');
657         $mods->removeChildNodes;
658
659         # Add the metarecord ID as a (locally defined) info URI
660         my $recordInfo = $mods
661                 ->ownerDocument
662                 ->createElement("mods:recordInfo");
663
664         my $recordIdentifier = $mods
665                 ->ownerDocument
666                 ->createElement("mods:recordIdentifier");
667
668         my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
669         $year += 1900;
670         $month += 1;
671
672         my $id = $mr->id;
673         $recordIdentifier->appendTextNode(
674                 sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:metabib-metarecord/$id", $month, $day)
675         );
676
677         $recordInfo->appendChild($recordIdentifier);
678         $mods->appendChild($recordInfo);
679
680         # Grab the title, author and ISBN for the master record and populate the metarecord
681         my ($title) = $master_mods->findnodes( './mods:titleInfo[not(@type)]' );
682         
683         if ($title) {
684                 $title->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
685                 $title = $mods->ownerDocument->importNode($title);
686                 $mods->appendChild($title);
687         }
688
689         my ($author) = $master_mods->findnodes( './mods:name[mods:role/mods:text[text()="creator"]]' );
690         if ($author) {
691                 $author->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
692                 $author = $mods->ownerDocument->importNode($author);
693                 $mods->appendChild($author);
694         }
695
696         my ($isbn) = $master_mods->findnodes( './mods:identifier[@type="isbn"]' );
697         if ($isbn) {
698                 $isbn->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
699                 $isbn = $mods->ownerDocument->importNode($isbn);
700                 $mods->appendChild($isbn);
701         }
702
703         # ... and loop over the constituent records
704         for my $map ( @$recs ) {
705
706                 # get the MODS
707                 my ($rec) =
708                         $self   ->method_lookup('open-ils.supercat.record.mods.retrieve')
709                                 ->run($map->source);
710
711                 my $part_mods = $_parser->parse_string($rec);
712                 $part_mods->documentElement->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
713                 ($part_mods) = $part_mods->findnodes('//mods:mods');
714
715                 for my $node ( ($part_mods->findnodes( './mods:subject' )) ) {
716                         $node->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
717                         $node = $mods->ownerDocument->importNode($node);
718                         $mods->appendChild( $node );
719                 }
720
721                 my $relatedItem = $mods
722                         ->ownerDocument
723                         ->createElement("mods:relatedItem");
724
725                 $relatedItem->setAttribute( type => 'constituent' );
726
727                 my $identifier = $mods
728                         ->ownerDocument
729                         ->createElement("mods:identifier");
730
731                 $identifier->setAttribute( type => 'uri' );
732
733                 my $subRecordInfo = $mods
734                         ->ownerDocument
735                         ->createElement("mods:recordInfo");
736
737                 my $subRecordIdentifier = $mods
738                         ->ownerDocument
739                         ->createElement("mods:recordIdentifier");
740
741                 my $subid = $map->source;
742                 $subRecordIdentifier->appendTextNode(
743                         sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:biblio-record_entry/$subid",
744                                 $month,
745                                 $day
746                         )
747                 );
748                 $subRecordInfo->appendChild($subRecordIdentifier);
749
750                 $relatedItem->appendChild( $subRecordInfo );
751
752                 my ($tor) = $part_mods->findnodes( './mods:typeOfResource' );
753                 $tor->setNamespace( "http://www.loc.gov/mods/", "mods", 1 ) if ($tor);
754                 $tor = $mods->ownerDocument->importNode($tor) if ($tor);
755                 $relatedItem->appendChild($tor) if ($tor);
756
757                 if ( my ($part_isbn) = $part_mods->findnodes( './mods:identifier[@type="isbn"]' ) ) {
758                         $part_isbn->setNamespace( "http://www.loc.gov/mods/", "mods", 1 );
759                         $part_isbn = $mods->ownerDocument->importNode($part_isbn);
760                         $relatedItem->appendChild( $part_isbn );
761
762                         if (!$isbn) {
763                                 $isbn = $mods->appendChild( $part_isbn->cloneNode(1) );
764                         }
765                 }
766
767                 $mods->appendChild( $relatedItem );
768
769         }
770
771         $_storage->disconnect;
772
773         return entityize($mods->toString);
774
775 }
776 __PACKAGE__->register_method(
777         method    => 'retrieve_metarecord_mods',
778         api_name  => 'open-ils.supercat.metarecord.mods.retrieve',
779         api_level => 1,
780         argc      => 1,
781         signature =>
782                 { desc     => <<"                 DESC",
783 Returns the MODS representation of the requested metarecord
784                   DESC
785                   params   =>
786                         [
787                                 { name => 'metarecordId',
788                                   desc => 'An OpenILS metabib::metarecord id',
789                                   type => 'number' },
790                         ],
791                   'return' =>
792                         { desc => 'The metarecord in MODS',
793                           type => 'string' }
794                 }
795 );
796
797 sub list_metarecord_formats {
798         my @list = (
799                 { mods =>
800                         { namespace_uri   => 'http://www.loc.gov/mods/',
801                           docs            => 'http://www.loc.gov/mods/',
802                           schema_location => 'http://www.loc.gov/standards/mods/mods.xsd',
803                         }
804                 }
805         );
806
807         for my $type ( keys %metarecord_xslt ) {
808                 push @list,
809                         { $type => 
810                                 { namespace_uri   => $metarecord_xslt{$type}{namespace_uri},
811                                   docs            => $metarecord_xslt{$type}{docs},
812                                   schema_location => $metarecord_xslt{$type}{schema_location},
813                                 }
814                         };
815         }
816
817         return \@list;
818 }
819 __PACKAGE__->register_method(
820         method    => 'list_metarecord_formats',
821         api_name  => 'open-ils.supercat.metarecord.formats',
822         api_level => 1,
823         argc      => 0,
824         signature =>
825                 { desc     => <<"                 DESC",
826 Returns the list of valid metarecord formats that supercat understands.
827                   DESC
828                   'return' =>
829                         { desc => 'The format list',
830                           type => 'array' }
831                 }
832 );
833
834
835 sub list_record_formats {
836         my @list = (
837                 { marcxml =>
838                         { namespace_uri   => 'http://www.loc.gov/MARC21/slim',
839                           docs            => 'http://www.loc.gov/marcxml/',
840                           schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd',
841                         }
842                 }
843         );
844
845         for my $type ( keys %record_xslt ) {
846                 push @list,
847                         { $type => 
848                                 { namespace_uri   => $record_xslt{$type}{namespace_uri},
849                                   docs            => $record_xslt{$type}{docs},
850                                   schema_location => $record_xslt{$type}{schema_location},
851                                 }
852                         };
853         }
854
855         return \@list;
856 }
857 __PACKAGE__->register_method(
858         method    => 'list_record_formats',
859         api_name  => 'open-ils.supercat.record.formats',
860         api_level => 1,
861         argc      => 0,
862         signature =>
863                 { desc     => <<"                 DESC",
864 Returns the list of valid record formats that supercat understands.
865                   DESC
866                   'return' =>
867                         { desc => 'The format list',
868                           type => 'array' }
869                 }
870 );
871
872
873 sub oISBN {
874         my $self = shift;
875         my $client = shift;
876         my $isbn = shift;
877
878         throw OpenSRF::EX::InvalidArg ('I need an ISBN please')
879                 unless (length($isbn) >= 10);
880
881         my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
882
883         # Create a storage session, since we'll be making muliple requests.
884         $_storage->connect;
885
886         # Find the record that has that ISBN.
887         my $bibrec = $_storage->request(
888                 'open-ils.cstore.direct.metabib.full_rec.search.atomic',
889                 { tag => '020', subfield => 'a', value => { ilike => $isbn.'%'} }
890         )->gather(1);
891
892         # Go away if we don't have one.
893         return {} unless (@$bibrec);
894
895         # Find the metarecord for that bib record.
896         my $mr = $_storage->request(
897                 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
898                 {source => $bibrec->[0]->record}
899         )->gather(1);
900
901         # Find the other records for that metarecord.
902         my $records = $_storage->request(
903                 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
904                 {metarecord => $mr->[0]->metarecord}
905         )->gather(1);
906
907         # Just to be safe.  There's currently no unique constraint on sources...
908         my %unique_recs = map { ($_->source, 1) } @$records;
909         my @rec_list = sort keys %unique_recs;
910
911         # And now fetch the ISBNs for thos records.
912         my $recs = $_storage->request(
913                 'open-ils.cstore.direct.metabib.full_rec.search.atomic',
914                 { tag => '020', subfield => 'a', record => \@rec_list }
915         )->gather(1);
916
917         # We're done with the storage server session.
918         $_storage->disconnect;
919
920         # Return the oISBN data structure.  This will be XMLized at a higher layer.
921         return
922                 { metarecord => $mr->[0]->metarecord,
923                   record_list => { map { ($_->record, $_->value) } @$recs } };
924
925 }
926 __PACKAGE__->register_method(
927         method    => 'oISBN',
928         api_name  => 'open-ils.supercat.oisbn',
929         api_level => 1,
930         argc      => 1,
931         signature =>
932                 { desc     => <<"                 DESC",
933 Returns the ISBN list for the metarecord of the requested isbn
934                   DESC
935                   params   =>
936                         [
937                                 { name => 'isbn',
938                                   desc => 'An ISBN.  Duh.',
939                                   type => 'string' },
940                         ],
941                   'return' =>
942                         { desc => 'record to isbn map',
943                           type => 'object' }
944                 }
945 );
946
947 1;