adcd2954831fd59a40a765b91bbae01531a209a8
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Cat.pm
1 use strict; use warnings;
2 package OpenILS::Application::Cat;
3 use OpenILS::Application::AppUtils;
4 use OpenSRF::Application;
5 use OpenILS::Application::Cat::Utils;
6 use OpenILS::Application::Cat::Merge;
7 use base qw/OpenSRF::Application/;
8 use Time::HiRes qw(time);
9 use OpenSRF::EX qw(:try);
10 use JSON;
11 use OpenILS::Utils::Fieldmapper;
12 use OpenILS::Event;
13 use OpenILS::Const qw/:const/;
14
15 use XML::LibXML;
16 use Unicode::Normalize;
17 use Data::Dumper;
18 use OpenILS::Utils::FlatXML;
19 use OpenILS::Utils::CStoreEditor q/:funcs/;
20 use OpenILS::Utils::Editor;
21 use OpenILS::Perm;
22 use OpenSRF::Utils::SettingsClient;
23 use OpenSRF::Utils::Logger qw($logger);
24 use OpenSRF::AppSession;
25
26 my $apputils = "OpenILS::Application::AppUtils";
27
28 my $utils = "OpenILS::Application::Cat::Utils";
29 my $U = "OpenILS::Application::AppUtils";
30
31 my $conf;
32
33 my %marctemplates;
34
35 sub entityize { 
36         my $stuff = shift;
37         my $form = shift || "";
38
39         if ($form eq 'D') {
40                 $stuff = NFD($stuff);
41         } else {
42                 $stuff = NFC($stuff);
43         }
44
45         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
46         return $stuff;
47 }
48
49 __PACKAGE__->register_method(
50         method  => "retrieve_marc_template",
51         api_name        => "open-ils.cat.biblio.marc_template.retrieve",
52         notes           => <<"  NOTES");
53         Returns a MARC 'record tree' based on a set of pre-defined templates.
54         Templates include : book
55         NOTES
56
57 sub retrieve_marc_template {
58         my( $self, $client, $type ) = @_;
59
60         return $marctemplates{$type} if defined($marctemplates{$type});
61         $marctemplates{$type} = _load_marc_template($type);
62         return $marctemplates{$type};
63 }
64
65 sub _load_marc_template {
66         my $type = shift;
67
68         if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; }
69
70         my $template = $conf->config_value(                                     
71                 "apps", "open-ils.cat","app_settings", "marctemplates", $type );
72         warn "Opening template file $template\n";
73
74         open( F, $template ) or 
75                 throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@");
76
77         my @xml = <F>;
78         close(F);
79         my $xml = join('', @xml);
80
81         return XML::LibXML->new->parse_string($xml)->documentElement->toString;
82 }
83
84 my $__bib_sources;
85 sub bib_source_from_name {
86         my $name = shift;
87         $logger->debug("searching for bib source: $name");
88
89         $__bib_sources = new_editor()->retrieve_all_config_bib_source()
90                 unless $__bib_sources;
91
92         my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
93
94         return $s->id if $s;
95         return undef;
96 }
97
98
99
100 __PACKAGE__->register_method(
101         method  => "create_record_xml",
102         api_name        => "open-ils.cat.biblio.record.xml.create.override",
103         signature       => q/@see open-ils.cat.biblio.record.xml.create/);
104
105 __PACKAGE__->register_method(
106         method          => "create_record_xml",
107         api_name                => "open-ils.cat.biblio.record.xml.create",
108         signature       => q/
109                 Inserts a new biblio with the given XML
110         /
111 );
112
113 sub create_record_xml {
114         my( $self, $client, $login, $xml, $source ) = @_;
115
116         my $override = 1 if $self->api_name =~ /override/;
117
118         my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
119         return $evt if $evt;
120
121         $logger->activity("user ".$user_obj->id." creating new MARC record");
122
123         my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
124
125         $meth = $self->method_lookup(
126                 "open-ils.cat.biblio.record.xml.import.override") if $override;
127
128         my ($s) = $meth->run($login, $xml, $source);
129         return $s;
130 }
131
132
133
134 __PACKAGE__->register_method(
135         method  => "biblio_record_replace_marc",
136         api_name        => "open-ils.cat.biblio.record.xml.update",
137         argc            => 3, 
138         signature       => q/
139                 Updates the XML for a given biblio record.
140                 This does not change any other aspect of the record entry
141                 exception the XML, the editor, and the edit date.
142                 @return The update record object
143         /
144 );
145
146 __PACKAGE__->register_method(
147         method          => 'biblio_record_replace_marc',
148         api_name                => 'open-ils.cat.biblio.record.marc.replace',
149         signature       => q/
150                 @param auth The authtoken
151                 @param recid The record whose MARC we're replacing
152                 @param newxml The new xml to use
153         /
154 );
155
156 __PACKAGE__->register_method(
157         method          => 'biblio_record_replace_marc',
158         api_name                => 'open-ils.cat.biblio.record.marc.replace.override',
159         signature       => q/@see open-ils.cat.biblio.record.marc.replace/
160 );
161
162 sub biblio_record_replace_marc  {
163         my( $self, $conn, $auth, $recid, $newxml, $source ) = @_;
164
165         my $e = OpenILS::Utils::Editor->new(authtoken=>$auth, xact=>1);
166
167         return $e->event unless $e->checkauth;
168         return $e->event unless $e->allowed('CREATE_MARC');
169
170         my $rec = $e->retrieve_biblio_record_entry($recid)
171                 or return $e->event;
172
173         my $fixtcn = 1 if $self->api_name =~ /replace/o;
174
175         # See if there is a different record in the database that has our TCN value
176         # If we're not updating the TCN, all we care about it the marcdoc
177         my $override = $self->api_name =~ /override/;
178
179         my $storage = OpenSRF::AppSession->create('open-ils.storage');
180
181         my( $tcn, $tsource, $marcdoc, $evt) = 
182                 _find_tcn_info($e->session, $newxml, $override, $recid);
183
184         return $evt if $evt;
185
186         if( $fixtcn ) {
187                 $rec->tcn_value($tcn);
188                 $rec->tcn_source($tsource);
189         }
190
191         $rec->source(bib_source_from_name($source)) if $source;
192         $rec->editor($e->requestor->id);
193         $rec->edit_date('now');
194         $rec->marc( entityize( $marcdoc->documentElement->toString ) );
195
196         $logger->activity("user ".$e->requestor->id." replacing MARC for record $recid");
197
198         $e->update_biblio_record_entry($rec) or return $e->event;
199         $e->commit;
200
201         $U->simplereq(
202                 'open-ils.ingest',
203                 'open-ils.ingest.full.biblio.record', $recid );
204
205         return $rec;
206
207         #$e->request('open-ils.worm.wormize.biblio', $recid) or return $e->event;
208         #$e->commit;
209
210         return $rec;
211 }
212
213
214
215
216 __PACKAGE__->register_method(
217         method  => "biblio_record_xml_import",
218         api_name        => "open-ils.cat.biblio.record.xml.import.override",
219         signature       => q/@see open-ils.cat.biblio.record.xml.import/);
220
221 __PACKAGE__->register_method(
222         method  => "biblio_record_xml_import",
223         api_name        => "open-ils.cat.biblio.record.xml.import",
224         notes           => <<"  NOTES");
225         Takes a marcxml record and imports the record into the database.  In this
226         case, the marcxml record is assumed to be a complete record (i.e. valid
227         MARC).  The title control number is taken from (whichever comes first)
228         tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
229         in the database.
230         user_session must have IMPORT_MARC permissions
231         NOTES
232
233
234 sub biblio_record_xml_import {
235         my( $self, $client, $authtoken, $xml, $source) = @_;
236
237
238         # XXX Make the source the ID from config.bib_source
239
240         my $override = 1 if $self->api_name =~ /override/;
241
242         my( $tcn, $tcn_source, $marcdoc );
243         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'IMPORT_MARC');
244         return $evt if $evt;
245
246         my $session = $apputils->start_db_session();
247
248         ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($session, $xml, $override);
249         return $evt if $evt;
250
251         $logger->activity("user ".$requestor->id.
252                 " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
253
254         my $record = Fieldmapper::biblio::record_entry->new;
255
256         $record->source(bib_source_from_name($source)) if $source;
257         $record->tcn_source($tcn_source);
258         $record->tcn_value($tcn);
259         $record->creator($requestor->id);
260         $record->editor($requestor->id);
261         $record->create_date('now');
262         $record->edit_date('now');
263         $record->marc( entityize( $marcdoc->documentElement->toString ) );
264
265         my $id = $session->request(
266                 "open-ils.storage.direct.biblio.record_entry.create", $record )->gather(1);
267
268         return $U->DB_UPDATE_FAILED($record) unless $id;
269         $record->id( $id );
270
271         $logger->info("marc create/import created new record $id");
272
273         $apputils->commit_db_session($session);
274
275         $logger->debug("Sending record off to be wormized");
276
277
278         $U->simplereq(
279                 'open-ils.ingest',
280                 'open-ils.ingest.full.biblio.record', $id );
281
282 #       my $stat = $U->storagereq( 'open-ils.worm.wormize.biblio', $id );
283 #       throw OpenSRF::EX::ERROR 
284 #               ("Unable to wormize imported record") unless $stat;
285
286         return $record;
287 }
288
289
290 sub _find_tcn_info { 
291         my $session             = shift;
292         my $xml                 = shift;
293         my $override    = shift;
294         my $existing_rec        = shift || 0;
295
296         # parse the XML
297         my $marcxml = XML::LibXML->new->parse_string( $xml );
298         $marcxml->documentElement->setNamespace( 
299                 "http://www.loc.gov/MARC21/slim", "marc", 1 );
300
301         my $xpath = '//marc:controlfield[@tag="001"]';
302         my $tcn = $marcxml->documentElement->findvalue($xpath);
303         $logger->info("biblio import located 001 (tcn) value of $tcn");
304
305         $xpath = '//marc:controlfield[@tag="003"]';
306         my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
307
308         if(my $rec = _tcn_exists($session, $tcn, $tcn_source, $existing_rec) ) {
309
310                 my $origtcn = $tcn;
311                 $tcn = find_free_tcn( $marcxml, $session, $existing_rec );
312
313                 # if we're overriding, try to find a different TCN to use
314                 if( $override ) {
315
316                         $logger->activity("tcn value $tcn already exists, attempting to override");
317
318                         if(!$tcn) {
319                                 return ( 
320                                         undef, 
321                                         undef, 
322                                         undef,
323                                         OpenILS::Event->new(
324                                                 'OPEN_TCN_NOT_FOUND', 
325                                                         payload => $marcxml->toString())
326                                         );
327                         }
328
329                 } else {
330
331                         $logger->warn("tcn value $origtcn already exists in import/create");
332
333                         # otherwise, return event
334                         return ( 
335                                 undef, 
336                                 undef, 
337                                 undef,
338                                 OpenILS::Event->new( 
339                                         'TCN_EXISTS', payload => { 
340                                                 dup_record      => $rec, 
341                                                 tcn                     => $origtcn,
342                                                 new_tcn         => $tcn
343                                                 }
344                                         )
345                                 );
346                 }
347         }
348
349         return ($tcn, $tcn_source, $marcxml);
350 }
351
352 sub find_free_tcn {
353
354         my $marcxml = shift;
355         my $session = shift;
356         my $existing_rec = shift;
357
358         my $add_039 = 0;
359
360         my $xpath = '//marc:datafield[@tag="039"]/subfield[@code="a"]';
361         my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
362         $xpath = '//marc:datafield[@tag="039"]/subfield[@code="b"]';
363         my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
364
365         if(_tcn_exists($session, $tcn, $tcn_source, $existing_rec)) {
366                 $tcn = undef;
367         } else {
368                 $add_039++;
369         }
370
371
372         if(!$tcn) {
373                 $xpath = '//marc:datafield[@tag="020"]/subfield[@code="a"]';
374                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
375                 $tcn_source = "ISBN";
376                 if(_tcn_exists($session, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
377         }
378
379         if(!$tcn) { 
380                 $xpath = '//marc:datafield[@tag="022"]/subfield[@code="a"]';
381                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
382                 $tcn_source = "ISSN";
383                 if(_tcn_exists($session, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
384         }
385
386         if(!$tcn) {
387                 $xpath = '//marc:datafield[@tag="010"]';
388                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
389                 $tcn_source = "LCCN";
390                 if(_tcn_exists($session, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
391         }
392
393         if(!$tcn) {
394                 $xpath = '//marc:datafield[@tag="035"]/subfield[@code="a"]';
395                 ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
396                 $tcn_source = "System Legacy";
397                 if(_tcn_exists($session, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
398
399                 if($tcn) {
400                         $marcxml->documentElement->removeChild(
401                                 $marcxml->documentElement->findnodes( '//datafield[@tag="035"]' )
402                         );
403                 }
404         }
405
406         return undef unless $tcn;
407
408         if ($add_039) {
409                 my $df = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'datafield');
410                 $df->setAttribute( tag => '039' );
411                 $df->setAttribute( ind1 => ' ' );
412                 $df->setAttribute( ind2 => ' ' );
413                 $marcxml->documentElement->appendChild( $df );
414
415                 my $sfa = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'subfield');
416                 $sfa->setAttribute( code => 'a' );
417                 $sfa->appendChild( $marcxml->createTextNode( $tcn ) );
418                 $df->appendChild( $sfa );
419
420                 my $sfb = $marcxml->createElementNS( 'http://www.loc.gov/MARC21/slim', 'subfield');
421                 $sfb->setAttribute( code => 'b' );
422                 $sfb->appendChild( $marcxml->createTextNode( $tcn_source ) );
423                 $df->appendChild( $sfb );
424         }
425
426         return $tcn;
427 }
428
429
430
431 sub _tcn_exists {
432         my $session = shift;
433         my $tcn = shift;
434         my $source = shift;
435         my $existing_rec = shift || 0;
436
437         if(!$tcn) {return 0;}
438
439         $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
440
441         # XXX why does the source matter?
442 #       my $req = $session->request(      
443 #               { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
444
445         my $req = $session->request(      
446                 "open-ils.storage.id_list.biblio.record_entry.search_where.atomic",
447                 { tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec} } );
448
449         my $recs = $req->gather(1);
450
451         if($recs and $recs->[0]) {
452                 $logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
453                 return $recs->[0];
454         }
455
456         $logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
457         return 0;
458 }
459
460
461
462
463 # XXX deprecated. Remove me.
464
465 =head deprecated
466
467 __PACKAGE__->register_method(
468         method  => "biblio_record_tree_retrieve",
469         api_name        => "open-ils.cat.biblio.record.tree.retrieve",
470 );
471
472 sub biblio_record_tree_retrieve {
473
474         my( $self, $client, $recordid ) = @_;
475
476         my $name = "open-ils.storage.direct.biblio.record_entry.retrieve";
477         my $session = OpenSRF::AppSession->create( "open-ils.storage" );
478         my $request = $session->request( $name, $recordid );
479         my $marcxml = $request->gather(1);
480
481         if(!$marcxml) {
482                 throw OpenSRF::EX::ERROR 
483                         ("No record in database with id $recordid");
484         }
485
486         $session->disconnect();
487         $session->kill_me();
488
489         warn "turning into nodeset\n";
490         my $nodes = OpenILS::Utils::FlatXML->new()->xml_to_nodeset( $marcxml->marc ); 
491         warn "turning nodeset into tree\n";
492         my $tree = $utils->nodeset2tree( $nodes->nodeset );
493
494         $tree->owner_doc( $marcxml->id() );
495
496         warn "returning tree\n";
497
498         return $tree;
499 }
500 =cut
501
502
503 =head deprecate 
504 __PACKAGE__->register_method(
505         method  => "biblio_record_xml_update",
506         api_name        => "open-ils.cat.biblio.record.xml.update",
507         argc            => 3, #(session_id, biblio_tree ) 
508         notes           => <<'  NOTES');
509         Updates the XML of a biblio record entry
510         @param authtoken The session token for the staff updating the record
511         @param docID The record entry ID to update
512         @param xml The new MARCXML record
513         NOTES
514
515 sub biblio_record_xml_update {
516
517         my( $self, $client, $user_session,  $id, $xml ) = @_;
518
519         my $user_obj = $apputils->check_user_session($user_session); 
520
521         if($apputils->check_user_perms(
522                         $user_obj->id, $user_obj->home_ou, "UPDATE_MARC")) {
523                 return OpenILS::Perm->new("UPDATE_MARC"); 
524         }
525
526         $logger->activity("user ".$user_obj->id." updating biblio record $id");
527
528
529         my $session = OpenILS::Application::AppUtils->start_db_session();
530
531         warn "Retrieving biblio record from storage for update\n";
532
533         my $req1 = $session->request(
534                         "open-ils.storage.direct.biblio.record_entry.batch.retrieve", $id );
535         my $biblio = $req1->gather(1);
536
537         warn "retrieved doc $id\n";
538
539         my $doc = XML::LibXML->new->parse_string($xml);
540         throw OpenSRF::EX::ERROR ("Invalid XML in record update: $xml") unless $doc;
541
542         $biblio->marc( entityize( $doc->documentElement->toString ) );
543         $biblio->editor( $user_obj->id );
544         $biblio->edit_date( 'now' );
545
546         warn "Sending updated doc $id to db with xml ".$biblio->marc. "\n";
547
548         my $req = $session->request( 
549                 "open-ils.storage.direct.biblio.record_entry.update", $biblio );
550
551         $req->wait_complete;
552         my $status = $req->recv();
553         if( !$status || $status->isa("Error") || ! $status->content) {
554                 OpenILS::Application::AppUtils->rollback_db_session($session);
555                 if($status->isa("Error")) { throw $status ($status); }
556                 throw OpenSRF::EX::ERROR ("Error updating biblio record");
557         }
558         $req->finish();
559
560         # Send the doc to the wormer for wormizing
561         warn "Starting worm session\n";
562
563         my $success = 0;
564         my $wresp;
565
566         my $wreq = $session->request( "open-ils.worm.wormize.biblio", $id );
567
568         my $w = 0;
569         try {
570                 $w = $wreq->gather(1);
571
572         } catch Error with {
573                 my $e = shift;
574                 warn "wormizing failed, rolling back\n";
575                 OpenILS::Application::AppUtils->rollback_db_session($session);
576
577                 if($e) { throw $e ($e); }
578                 throw OpenSRF::EX::ERROR ("Wormizing Failed for $id" );
579         };
580
581         warn "Committing db session...\n";
582         OpenILS::Application::AppUtils->commit_db_session( $session );
583
584 #       $client->respond_complete($tree);
585
586         warn "Done wormizing\n";
587
588         #use Data::Dumper;
589         #warn "Returning tree:\n";
590         #warn Dumper $tree;
591
592         return $biblio;
593
594 }
595
596 =cut
597
598
599
600 __PACKAGE__->register_method(
601         method  => "biblio_record_record_metadata",
602         api_name        => "open-ils.cat.biblio.record.metadata.retrieve",
603         argc            => 1, #(session_id, biblio_tree ) 
604         notes           => "Walks the tree and commits any changed nodes " .
605                                         "adds any new nodes, and deletes any deleted nodes",
606 );
607
608 sub biblio_record_record_metadata {
609         my( $self, $client, $authtoken, $ids ) = @_;
610
611         return [] unless $ids and @$ids;
612
613         my $editor = new_editor(authtoken => $authtoken);
614         return $editor->event unless $editor->checkauth;
615         return $editor->event unless $editor->allowed('VIEW_USER');
616
617         my @results;
618
619         for(@$ids) {
620                 return $editor->event unless 
621                         my $rec = $editor->retrieve_biblio_record_entry($_);
622                 $rec->creator($editor->retrieve_actor_user($rec->creator));
623                 $rec->editor($editor->retrieve_actor_user($rec->editor));
624                 $rec->clear_marc; # slim the record down
625                 push( @results, $rec );
626         }
627
628         return \@results;
629 }
630
631
632
633 __PACKAGE__->register_method(
634         method  => "biblio_record_marc_cn",
635         api_name        => "open-ils.cat.biblio.record.marc_cn.retrieve",
636         argc            => 1, #(bib id ) 
637 );
638
639 sub biblio_record_marc_cn {
640         my( $self, $client, $id ) = @_;
641
642         my $session = OpenSRF::AppSession->create("open-ils.cstore");
643         my $marc = $session
644                 ->request("open-ils.cstore.direct.biblio.record_entry.retrieve", $id )
645                 ->gather(1)
646                 ->marc;
647
648         my $doc = XML::LibXML->new->parse_string($marc);
649         $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
650         
651         my @res;
652         for my $tag ( qw/050 055 060 070 080 082 086 088 090 092 096 098 099/ ) {
653                 my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
654                 for my $x (@node) {
655                         my $cn = $x->findvalue("marc:subfield[\@code='a' or \@code='b']");
656                         push @res, {$tag => $cn} if ($cn);
657                 }
658         }
659
660         return \@res
661 }
662
663 sub _get_id_by_userid {
664
665         my @users = @_;
666         my @ids;
667
668         my $session = OpenSRF::AppSession->create( "open-ils.cstore" );
669         my $request = $session->request( 
670                 "open-ils.cstore.direct.actor.user.search.atomic", { usrname => \@users } );
671
672         $request->wait_complete;
673         my $response = $request->recv();
674         if(!$request->complete) { 
675                 throw OpenSRF::EX::ERROR ("no response from cstore on user retrieve");
676         }
677
678         if(UNIVERSAL::isa( $response, "Error")){
679                 throw $response ($response);
680         }
681
682         for my $u (@{$response->content}) {
683                 next unless ref($u);
684                 push @ids, $u->id();
685         }
686
687         $request->finish;
688         $session->disconnect;
689         $session->kill_me();
690
691         return @ids;
692 }
693
694
695 # commits metadata objects to the db
696 sub _update_record_metadata {
697
698         my ($session, @docs ) = @_;
699
700         for my $doc (@docs) {
701
702                 my $user_obj = $doc->{user};
703                 my $docid = $doc->{docid};
704
705                 warn "Updating metata for doc $docid\n";
706
707                 my $request = $session->request( 
708                         "open-ils.storage.direct.biblio.record_entry.retrieve", $docid );
709                 my $record = $request->gather(1);
710
711                 warn "retrieved record\n";
712                 my ($id) = _get_id_by_userid($user_obj->usrname);
713
714                 warn "got $id from _get_id_by_userid\n";
715                 $record->editor($id);
716                 
717                 warn "Grabbed the record, updating and moving on\n";
718
719                 $request = $session->request( 
720                         "open-ils.storage.direct.biblio.record_entry.update", $record );
721                 $request->gather(1);
722         }
723
724         warn "committing metarecord update\n";
725
726         return 1;
727 }
728
729
730
731 __PACKAGE__->register_method(
732         method  => "orgs_for_title",
733         api_name        => "open-ils.cat.actor.org_unit.retrieve_by_title"
734 );
735
736 sub orgs_for_title {
737         my( $self, $client, $record_id ) = @_;
738
739         my $vols = $apputils->simple_scalar_request(
740                 "open-ils.cstore",
741                 "open-ils.cstore.direct.asset.call_number.search.atomic",
742                 { record => $record_id, deleted => 'f' });
743
744         my $orgs = { map {$_->owning_lib => 1 } @$vols };
745         return [ keys %$orgs ];
746 }
747
748
749 __PACKAGE__->register_method(
750         method  => "retrieve_copies",
751         api_name        => "open-ils.cat.asset.copy_tree.retrieve");
752
753 __PACKAGE__->register_method(
754         method  => "retrieve_copies",
755         api_name        => "open-ils.cat.asset.copy_tree.global.retrieve");
756
757 # user_session may be null/undef
758 sub retrieve_copies {
759
760         my( $self, $client, $user_session, $docid, @org_ids ) = @_;
761
762         if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
763
764         $docid = "$docid";
765
766         warn " $$ retrieving copy tree for orgs @org_ids and doc $docid at " . time() . "\n";
767
768         # grabbing copy trees should be available for everyone..
769         if(!@org_ids and $user_session) {
770                 my $user_obj = 
771                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
772                         @org_ids = ($user_obj->home_ou);
773         }
774
775         if( $self->api_name =~ /global/ ) {
776                 warn "performing global copy_tree search for $docid\n";
777                 return _build_volume_list( { record => $docid, deleted => 'f' } );
778
779         } else {
780
781                 my @all_vols;
782                 for my $orgid (@org_ids) {
783                         my $vols = _build_volume_list( 
784                                         { record => $docid, owning_lib => $orgid, deleted => 'f' } );
785                         warn "Volumes built for org $orgid\n";
786                         push( @all_vols, @$vols );
787                 }
788                 
789                 warn " $$ Finished copy_tree at " . time() . "\n";
790                 return \@all_vols;
791         }
792
793         return undef;
794 }
795
796
797 sub _build_volume_list {
798         my $search_hash = shift;
799
800         $search_hash->{deleted} = 'f';
801         my $e = new_editor();
802
803         my $vols = $e->search_asset_call_number($search_hash);
804
805         my @volumes;
806
807         for my $volume (@$vols) {
808
809                 my $copies = $e->search_asset_copy(
810                         { call_number => $volume->id , deleted => 'f' });
811
812                 $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
813
814                 for my $c (@$copies) {
815                         if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
816                                 $c->circulations(
817                                         $e->search_action_circulation(
818                                                 [
819                                                         { target_copy => $c->id },
820                                                         {
821                                                                 order_by => { circ => 'xact_start desc' },
822                                                                 limit => 1
823                                                         }
824                                                 ]
825                                         )
826                                 )
827                         }
828                 }
829
830                 $volume->copies($copies);
831                 push( @volumes, $volume );
832         }
833
834         #$session->disconnect();
835         return \@volumes;
836
837 }
838
839
840 __PACKAGE__->register_method(
841         method  => "fleshed_copy_update",
842         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update",);
843
844 __PACKAGE__->register_method(
845         method  => "fleshed_copy_update",
846         api_name        => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
847
848
849 sub fleshed_copy_update {
850         my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
851         return 1 unless ref $copies;
852         my( $reqr, $evt ) = $U->checkses($auth);
853         return $evt if $evt;
854         my $editor = new_editor(requestor => $reqr, xact => 1);
855         my $override = $self->api_name =~ /override/;
856         $evt = update_fleshed_copies($editor, $override, undef, $copies, $delete_stats);
857         return $evt if $evt;
858         $editor->finish;
859         $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
860         return 1;
861 }
862
863
864 __PACKAGE__->register_method(
865         method => 'merge',
866         api_name        => 'open-ils.cat.biblio.records.merge',
867         signature       => q/
868                 Merges a group of records
869                 @param auth The login session key
870                 @param master The id of the record all other r
871                         ecords should be merged into
872                 @param records Array of records to be merged into the master record
873                 @return 1 on success, Event on error.
874         /
875 );
876
877 sub merge {
878         my( $self, $conn, $auth, $master, $records ) = @_;
879         my( $reqr, $evt ) = $U->checkses($auth);
880         return $evt if $evt;
881         my $editor = new_editor( requestor => $reqr, xact => 1 );
882         my $v = OpenILS::Application::Cat::Merge::merge_records($editor, $master, $records);
883         return $v if $v;
884         $editor->finish;
885         return 1;
886 }
887
888
889
890
891 # ---------------------------------------------------------------------------
892 # ---------------------------------------------------------------------------
893
894 # returns true if the given title (id) has no un-deleted
895 # copies attached
896 sub title_is_empty {
897         my( $editor, $rid ) = @_;
898
899         my $cnlist = $editor->search_asset_call_number(
900                 { record => $rid, deleted => 'f' }, { idlist => 1 } );
901         return 1 unless @$cnlist;
902
903         for my $cn (@$cnlist) {
904                 my $copylist = $editor->search_asset_copy(
905                         { call_number => $cn, deleted => 'f' }, { idlist => 1 });
906                 return 0 if @$copylist; # false if we find any copies
907         }
908
909         return 1;
910 }
911
912
913 __PACKAGE__->register_method(
914         method  => "fleshed_volume_update",
915         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update",);
916
917 __PACKAGE__->register_method(
918         method  => "fleshed_volume_update",
919         api_name        => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
920
921 sub fleshed_volume_update {
922         my( $self, $conn, $auth, $volumes, $delete_stats ) = @_;
923         my( $reqr, $evt ) = $U->checkses($auth);
924         return $evt if $evt;
925
926         my $override = ($self->api_name =~ /override/);
927         my $editor = new_editor( requestor => $reqr, xact => 1 );
928
929         for my $vol (@$volumes) {
930                 $logger->info("vol-update: investigating volume ".$vol->id);
931
932                 $vol->editor($reqr->id);
933                 $vol->edit_date('now');
934
935                 my $copies = $vol->copies;
936                 $vol->clear_copies;
937
938                 $vol->editor($editor->requestor->id);
939                 $vol->edit_date('now');
940
941                 if( $vol->isdeleted ) {
942
943                         $logger->info("vol-update: deleting volume");
944                         my $cs = $editor->search_asset_copy(
945                                 { call_number => $vol->id, deleted => 'f' } );
946                         return OpenILS::Event->new(
947                                 'VOLUME_NOT_EMPTY', payload => $vol->id ) if @$cs;
948
949                         $vol->deleted('t');
950                         return $editor->event unless
951                                 $editor->update_asset_call_number($vol);
952
953                         
954                 } elsif( $vol->isnew ) {
955                         $logger->info("vol-update: creating volume");
956                         $evt = create_volume( $override, $editor, $vol );
957                         return $evt if $evt;
958
959                 } elsif( $vol->ischanged ) {
960                         $logger->info("vol-update: update volume");
961                         return $editor->event unless
962                                 $editor->update_asset_call_number($vol);
963                         return $evt if $evt;
964                 }
965
966                 # now update any attached copies
967                 if( @$copies and !$vol->isdeleted ) {
968                         $_->call_number($vol->id) for @$copies;
969                         $evt = update_fleshed_copies( $editor, $override, $vol, $copies, $delete_stats );
970                         return $evt if $evt;
971                 }
972         }
973
974         $editor->finish;
975         return scalar(@$volumes);
976 }
977
978
979 # this does the actual work
980 sub update_fleshed_copies {
981         my( $editor, $override, $vol, $copies, $delete_stats ) = @_;
982
983         my $evt;
984         my $fetchvol = ($vol) ? 0 : 1;
985
986         my %cache;
987         $cache{$vol->id} = $vol if $vol;
988
989         for my $copy (@$copies) {
990
991                 my $copyid = $copy->id;
992                 $logger->info("vol-update: inspecting copy $copyid");
993
994                 if( !($vol = $cache{$copy->call_number}) ) {
995                         $vol = $cache{$copy->call_number} = 
996                                 $editor->retrieve_asset_call_number($copy->call_number);
997                         return $editor->event unless $vol;
998                 }
999
1000                 $copy->editor($editor->requestor->id);
1001                 $copy->edit_date('now');
1002
1003                 $copy->status( $copy->status->id ) if ref($copy->status);
1004                 $copy->location( $copy->location->id ) if ref($copy->location);
1005                 $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
1006                 
1007                 my $sc_entries = $copy->stat_cat_entries;
1008                 $copy->clear_stat_cat_entries;
1009
1010                 if( $copy->isdeleted ) {
1011                         $evt = delete_copy($editor, $override, $vol, $copy);
1012                         return $evt if $evt;
1013
1014                 } elsif( $copy->isnew ) {
1015                         $evt = create_copy( $editor, $vol, $copy );
1016                         return $evt if $evt;
1017
1018                 } elsif( $copy->ischanged ) {
1019
1020                         $evt = update_copy( $editor, $override, $vol, $copy );
1021                         return $evt if $evt;
1022                 }
1023
1024                 $copy->stat_cat_entries( $sc_entries );
1025                 $evt = update_copy_stat_entries($editor, $copy, $delete_stats);
1026                 return $evt if $evt;
1027         }
1028
1029         $logger->debug("vol-update: done updating copy batch");
1030
1031         return undef;
1032 }
1033
1034 sub fix_copy_price {
1035         my $copy = shift;
1036         my $p = $copy->price || 0;
1037         $p =~ s/\$//og;
1038         $copy->price($p);
1039
1040         my $d = $copy->deposit_amount || 0;
1041         $d =~ s/\$//og;
1042         $copy->deposit_amount($d);
1043 }
1044
1045
1046 sub update_copy {
1047         my( $editor, $override, $vol, $copy ) = @_;
1048
1049         $logger->info("vol-update: updating copy ".$copy->id);
1050         my $orig_copy = $editor->retrieve_asset_copy($copy->id);
1051         my $orig_vol  = $editor->retrieve_asset_call_number($copy->call_number);
1052
1053         $copy->editor($editor->requestor->id);
1054         $copy->edit_date('now');
1055
1056         fix_copy_price($copy);
1057         return $editor->event unless
1058                 $editor->update_asset_copy( 
1059                         $copy, {checkperm=>1, permorg=>$vol->owning_lib});
1060
1061         return remove_empty_objects($editor, $override, $orig_vol);
1062 }
1063
1064
1065 sub remove_empty_objects {
1066         my( $editor, $override, $vol ) = @_; 
1067         if( title_is_empty($editor, $vol->record) ) {
1068
1069                 if( $override ) {
1070
1071                         # delete this volume if it's not already marked as deleted
1072                         unless( $U->is_true($vol->deleted) || $vol->isdeleted ) {
1073                                 $vol->deleted('t');
1074                                 $vol->editor($editor->requestor->id);
1075                                 $vol->edit_date('now');
1076                                 $editor->update_asset_call_number($vol, {checkperm=>0})
1077                                         or return $editor->event;
1078                         }
1079
1080                         # then delete the record this volume points to
1081                         my $rec = $editor->retrieve_biblio_record_entry($vol->record)
1082                                 or return $editor->event;
1083
1084                         unless( $U->is_true($rec->deleted) ) {
1085                                 $rec->deleted('t');
1086                                 $rec->active('f');
1087                                 $editor->update_biblio_record_entry($rec, {checkperm=>0})
1088                                         or return $editor->event;
1089                         }
1090
1091                 } else {
1092                         return OpenILS::Event->new('TITLE_LAST_COPY', payload => $vol->record );
1093                 }
1094         }
1095
1096         return undef;
1097 }
1098
1099
1100 sub delete_copy {
1101         my( $editor, $override, $vol, $copy ) = @_;
1102
1103         $logger->info("vol-update: deleting copy ".$copy->id);
1104         $copy->deleted('t');
1105
1106         $copy->editor($editor->requestor->id);
1107         $copy->edit_date('now');
1108         $editor->update_asset_copy(
1109                 $copy, {checkperm=>1, permorg=>$vol->owning_lib})
1110                 or return $editor->event;
1111
1112         # Delete any open transits for this copy
1113         my $transits = $editor->search_action_transit_copy(
1114                 { target_copy=>$copy->id, dest_recv_time => undef } );
1115
1116         for my $t (@$transits) {
1117                 $editor->delete_action_transit_copy($t)
1118                         or return $editor->event;
1119         }
1120
1121         return remove_empty_objects($editor, $override, $vol);
1122 }
1123
1124
1125 sub create_copy {
1126         my( $editor, $vol, $copy ) = @_;
1127
1128         my $existing = $editor->search_asset_copy(
1129                 { barcode => $copy->barcode, deleted => 'f' } );
1130         
1131         return OpenILS::Event->new('ITEM_BARCODE_EXISTS') if @$existing;
1132
1133         $copy->clear_id;
1134         $copy->creator($editor->requestor->id);
1135         $copy->create_date('now');
1136         fix_copy_price($copy);
1137
1138         $editor->create_asset_copy(
1139                 $copy, {checkperm=>1, permorg=>$vol->owning_lib})
1140                 or return $editor->event;
1141
1142         return undef;
1143 }
1144
1145 # if 'delete_stats' is true, the copy->stat_cat_entries data is 
1146 # treated as the authoritative list for the copy. existing entries
1147 # that are not in said list will be deleted from the DB
1148 sub update_copy_stat_entries {
1149         my( $editor, $copy, $delete_stats ) = @_;
1150
1151         return undef if $copy->isdeleted;
1152
1153         my $evt;
1154         my $entries = $copy->stat_cat_entries;
1155
1156         if( $delete_stats ) {
1157                 $entries = ($entries and @$entries) ? $entries : [];
1158         } else {
1159                 return undef unless ($entries and @$entries);
1160         }
1161
1162         my $maps = $editor->search_asset_stat_cat_entry_copy_map({owning_copy=>$copy->id});
1163
1164         if(!$copy->isnew) {
1165                 # if there is no stat cat entry on the copy who's id matches the
1166                 # current map's id, remove the map from the database
1167                 for my $map (@$maps) {
1168                         if(! grep { $_->id == $map->stat_cat_entry } @$entries ) {
1169
1170                                 $logger->info("copy update found stale ".
1171                                         "stat cat entry map ".$map->id. " on copy ".$copy->id);
1172
1173                                 $editor->delete_asset_stat_cat_entry_copy_map($map)
1174                                         or return $editor->event;
1175                         }
1176                 }
1177         }
1178
1179         # go through the stat cat update/create process
1180         for my $entry (@$entries) { 
1181                 next unless $entry;
1182
1183                 # if this link already exists in the DB, don't attempt to re-create it
1184                 next if( grep{$_->stat_cat_entry == $entry->id} @$maps );
1185         
1186                 my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
1187
1188                 my $sc = ref($entry->stat_cat) ? $entry->stat_cat->id : $entry->stat_cat;
1189                 
1190                 $new_map->stat_cat( $sc );
1191                 $new_map->stat_cat_entry( $entry->id );
1192                 $new_map->owning_copy( $copy->id );
1193
1194                 $editor->create_asset_stat_cat_entry_copy_map($new_map)
1195                         or return $editor->event;
1196
1197                 $logger->info("copy update created new stat cat entry map ".$editor->data);
1198         }
1199
1200         return undef;
1201 }
1202
1203
1204 sub create_volume {
1205         my( $override, $editor, $vol ) = @_;
1206         my $evt;
1207
1208         # first lets see if there are any collisions
1209         my $vols = $editor->search_asset_call_number( { 
1210                         owning_lib      => $vol->owning_lib,
1211                         record          => $vol->record,
1212                         label                   => $vol->label,
1213                         deleted         => 'f'
1214                 }
1215         );
1216
1217         my $label = undef;
1218         if(@$vols) {
1219                 if($override) { 
1220                         $label = $vol->label;
1221                 } else {
1222                         return OpenILS::Event->new(
1223                                 'VOLUME_LABEL_EXISTS', payload => $vol->id);
1224                 }
1225         }
1226
1227         # create a temp label so we can create the volume, then de-dup it
1228         $vol->label( '__SYSTEM_TMP_'.time) if $label;
1229
1230         $vol->creator($editor->requestor->id);
1231         $vol->create_date('now');
1232         $vol->editor($editor->requestor->id);
1233         $vol->edit_date('now');
1234         $vol->clear_id;
1235
1236         $editor->create_asset_call_number($vol) or return $editor->event;
1237
1238         if($label) {
1239                 # now restore the label and merge into the existing record
1240                 $vol->label($label);
1241                 (undef, $evt) = 
1242                         OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $$vols[0]);
1243                 return $evt if $evt;
1244         }
1245
1246         return undef;
1247 }
1248
1249
1250 __PACKAGE__->register_method (
1251         method => 'batch_volume_transfer',
1252         api_name => 'open-ils.cat.asset.volume.batch.transfer',
1253 );
1254
1255 __PACKAGE__->register_method (
1256         method => 'batch_volume_transfer',
1257         api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1258 );
1259
1260
1261 sub batch_volume_transfer {
1262         my( $self, $conn, $auth, $args ) = @_;
1263
1264         my $evt;
1265         my $rec         = $$args{docid};
1266         my $o_lib       = $$args{lib};
1267         my $vol_ids = $$args{volumes};
1268
1269         my $override = 1 if $self->api_name =~ /override/;
1270
1271         $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1272
1273         my $e = new_editor(authtoken => $auth, xact =>1);
1274         return $e->event unless $e->checkauth;
1275         return $e->event unless $e->allowed('VOLUME_UPDATE');
1276
1277         my $dorg = $e->retrieve_actor_org_unit($o_lib)
1278                 or return $e->event;
1279
1280         my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1281                 or return $e->event;
1282
1283         return OpenILS::Event->new('ORG_CANNOT_HAVE_VOLS')
1284                 unless $U->is_true($ou_type->can_have_vols);
1285
1286         my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1287         my @seen;
1288
1289         for my $vol (@$vols) {
1290
1291                 # if we've already looked at this volume, go to the next
1292                 next if !$vol or grep { $vol->id == $_ } @seen;
1293
1294                 # grab all of the volumes in the list that have 
1295                 # the same label so they can be merged
1296                 my @all = grep { $_->label eq $vol->label } @$vols;
1297
1298                 # take note of the fact that we've looked at this set of volumes
1299                 push( @seen, $_->id ) for @all;
1300
1301                 # for each volume, see if there are any copies that have a 
1302                 # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).  
1303                 # if so, warn them
1304                 unless( $override ) {
1305                         for my $v (@all) {
1306
1307                                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1308                                 my $args = { 
1309                                         call_number     => $v->id, 
1310                                         circ_lib                => { "!=" => $v->owning_lib },
1311                                         deleted         => 'f'
1312                                 };
1313
1314                                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1315
1316                                 # if the copy's circ_lib matches the destination lib,
1317                                 # that's ok too
1318                                 $copies = [ grep { $_->circ_lib ne $o_lib } @$copies ];
1319                                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1320                         }
1321                 }
1322
1323                 # see if there is a volume at the destination lib that 
1324                 # already has the requested label
1325                 my $existing_vol = $e->search_asset_call_number(
1326                         {
1327                                 label                   => $vol->label, 
1328                                 record          =>$rec, 
1329                                 owning_lib      =>$o_lib,
1330                                 deleted         => 'f'
1331                         }
1332                 )->[0];
1333
1334                 if( $existing_vol ) {
1335
1336                         if( grep { $_->id == $existing_vol->id } @all ) {
1337                                 # this volume is already accounted for in our list of volumes to merge
1338                                 $existing_vol = undef;
1339
1340                         } else {
1341                                 # this volume exists on the destination record/owning_lib and must
1342                                 # be used as the destination for merging
1343                                 $logger->debug("merge: volume already exists at destination record: ".
1344                                         $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1345                         }
1346                 } 
1347
1348                 if( @all > 1 || $existing_vol ) {
1349                         $logger->info("merge: found collisions in volume transfer");
1350                         my @args = ($e, \@all);
1351                         @args = ($e, \@all, $existing_vol) if $existing_vol;
1352                         ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1353                         return $evt if $evt;
1354                 } 
1355                 
1356                 if( !$existing_vol ) {
1357
1358                         $vol->owning_lib($o_lib);
1359                         $vol->record($rec);
1360                         $vol->editor($e->requestor->id);
1361                         $vol->edit_date('now');
1362         
1363                         $logger->info("merge: updating volume ".$vol->id);
1364                         $e->update_asset_call_number($vol) or return $e->event;
1365
1366                 } else {
1367                         $logger->info("merge: bypassing volume update because existing volume used as target");
1368                 }
1369
1370                 # regardless of what volume was used as the destination, 
1371                 # update any copies that have moved over to the new lib
1372                 my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1373
1374                 # update circ lib on the copies - make this a method flag?
1375                 for my $copy (@$copies) {
1376                         next if $copy->circ_lib == $o_lib;
1377                         $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1378                         $copy->circ_lib($o_lib);
1379                         $copy->editor($e->requestor->id);
1380                         $copy->edit_date('now');
1381                         $e->update_asset_copy($copy) or return $e->event;
1382                 }
1383
1384                 # Now see if any empty records need to be deleted after all of this
1385                 for(@all) {
1386                         $evt = remove_empty_objects($e, $override, $_);
1387                         return $evt if $evt;
1388                 }
1389         }
1390
1391         $logger->info("merge: transfer succeeded");
1392         $e->commit;
1393         return 1;
1394 }
1395
1396
1397
1398
1399
1400
1401 1;