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 base qw/OpenSRF::Application/;
7 use Time::HiRes qw(time);
8 use OpenSRF::EX qw(:try);
10 use OpenILS::Utils::Fieldmapper;
13 use OpenILS::Utils::FlatXML;
16 my $apputils = "OpenILS::Application::AppUtils";
18 my $utils = "OpenILS::Application::Cat::Utils";
21 __PACKAGE__->register_method(
22 method => "biblio_record_tree_import",
23 api_name => "open-ils.cat.biblio.record.tree.import",
25 Takes a record tree and imports the record into the database. In this
26 case, the record tree is assumed to be a complete record (i.e. valid
27 MARC. The title control number is taken from (whichever comes first)
28 tags 001, 020, 022, 010, 035 and whichever does not already exist
30 user_session must have IMPORT_MARC permissions
34 sub biblio_record_tree_import {
35 my( $self, $client, $user_session, $tree) = @_;
36 my $user_obj = $apputils->check_user_session($user_session);
38 if($apputils->check_user_perms(
39 $user_obj->id, $user_obj->home_ou, "IMPORT_MARC")) {
40 return OpenILS::Perm->new("IMPORT_MARC");
43 warn "importing new record " . Dumper($tree) . "\n";
45 my $nodeset = $utils->tree2nodeset($tree);
46 warn "turned into nodeset " . Dumper($nodeset) . "\n";
48 # copy the doc so that we can mangle the namespace.
49 my $marcxml = OpenILS::Utils::FlatXML->new()->nodeset_to_xml($nodeset);
50 my $copy_marcxml = XML::LibXML->new->parse_string($marcxml->toString);
52 $marcxml->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
56 warn "Starting db session in import\n";
57 my $session = $apputils->start_db_session();
58 my $source = 2; # system local source
60 my $xpath = '//controlfield[@tag="001"]';
61 $tcn = $marcxml->documentElement->findvalue($xpath);
62 if(_tcn_exists($session, $tcn)) {$tcn = undef;}
63 my $tcn_source = "External";
67 $xpath = '//datafield[@tag="020"]';
68 $tcn = $marcxml->documentElement->findvalue($xpath);
70 if(_tcn_exists($session, $tcn)) {$tcn = undef;}
74 $xpath = '//datafield[@tag="022"]';
75 $tcn = $marcxml->documentElement->findvalue($xpath);
77 if(_tcn_exists($session, $tcn)) {$tcn = undef;}
81 $xpath = '//datafield[@tag="010"]';
82 $tcn = $marcxml->documentElement->findvalue($xpath);
84 if(_tcn_exists($session, $tcn)) {$tcn = undef;}
88 $xpath = '//datafield[@tag="035"]';
89 $tcn = $marcxml->documentElement->findvalue($xpath);
90 $tcn_source = "System";
91 if(_tcn_exists($session, $tcn)) {$tcn = undef;}
94 warn "Record import with tcn: $tcn and source $tcn_source\n";
96 my $record = Fieldmapper::biblio::record_entry->new;
98 $record->source($source);
99 $record->tcn_source($tcn_source);
100 $record->tcn_value($tcn);
101 $record->creator($user_obj->id);
102 $record->editor($user_obj->id);
103 $record->marc($copy_marcxml->toString);
106 my $req = $session->request(
107 "open-ils.storage.direct.biblio.record_entry.create",
109 my $id = $req->gather(1);
111 my $wreq = $session->request("open-ils.worm.wormize", $id);
114 $apputils->commit_db_session($session);
116 return $self->biblio_record_tree_retrieve($client, $id);
123 if(!$tcn) {return 0;}
125 my $req = $session->request(
126 "open-ils.storage.direct.biblio.record_entry.search.tcn_value.atomic",
128 my $recs = $req->gather(1);
130 if($recs and $recs->[0]) {
138 __PACKAGE__->register_method(
139 method => "biblio_record_tree_retrieve",
140 api_name => "open-ils.cat.biblio.record.tree.retrieve",
143 sub biblio_record_tree_retrieve {
145 my( $self, $client, $recordid ) = @_;
147 my $name = "open-ils.storage.direct.biblio.record_entry.retrieve";
148 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
149 my $request = $session->request( $name, $recordid );
150 my $marcxml = $request->gather(1);
153 throw OpenSRF::EX::ERROR
154 ("No record in database with id $recordid");
157 $session->disconnect();
160 warn "turning into nodeset\n";
161 my $nodes = OpenILS::Utils::FlatXML->new()->xml_to_nodeset( $marcxml->marc );
162 warn "turning nodeset into tree\n";
163 my $tree = $utils->nodeset2tree( $nodes->nodeset );
165 $tree->owner_doc( $marcxml->id() );
167 warn "returning tree\n";
172 __PACKAGE__->register_method(
173 method => "biblio_record_tree_commit",
174 api_name => "open-ils.cat.biblio.record.tree.commit",
175 argc => 3, #(session_id, biblio_tree )
176 notes => <<" NOTES");
177 Walks the tree and commits any changed nodes
178 adds any new nodes, and deletes any deleted nodes
179 The record to commit must already exist or this
183 sub biblio_record_tree_commit {
185 my( $self, $client, $user_session, $tree ) = @_;
187 throw OpenSRF::EX::InvalidArg
188 ("Not enough args to to open-ils.cat.biblio.record.tree.commit")
189 unless ( $user_session and $tree );
191 my $user_obj = $apputils->check_user_session($user_session);
193 if($apputils->check_user_perms(
194 $user_obj->id, $user_obj->home_ou, "UPDATE_MARC")) {
195 return OpenILS::Perm->new("UPDATE_MARC");
200 my $docid = $tree->owner_doc();
201 my $session = OpenILS::Application::AppUtils->start_db_session();
203 warn "Retrieving biblio record from storage for update\n";
205 my $req1 = $session->request(
206 "open-ils.storage.direct.biblio.record_entry.batch.retrieve", $docid );
207 my $biblio = $req1->gather(1);
209 warn "retrieved doc $docid\n";
212 # turn the tree into a nodeset
213 my $nodeset = $utils->tree2nodeset($tree);
214 $nodeset = $utils->clean_nodeset($nodeset);
216 if(!defined($docid)) { # be sure
217 for my $node (@$nodeset) {
218 $docid = $node->owner_doc();
219 last if defined($docid);
223 # turn the nodeset into a doc
224 my $marcxml = OpenILS::Utils::FlatXML->new()->nodeset_to_xml( $nodeset );
226 $biblio->marc( $marcxml->toString() );
228 warn "Starting db session\n";
230 my $x = _update_record_metadata( $session, { user => $user_obj, docid => $docid } );
231 OpenILS::Application::AppUtils->rollback_db_session($session) unless $x;
233 warn "Sending updated doc $docid to db\n";
234 my $req = $session->request( "open-ils.storage.direct.biblio.record_entry.update", $biblio );
237 my $status = $req->recv();
238 if( !$status || $status->isa("Error") || ! $status->content) {
239 OpenILS::Application::AppUtils->rollback_db_session($session);
240 if($status->isa("Error")) { throw $status ($status); }
241 throw OpenSRF::EX::ERROR ("Error updating biblio record");
245 # Send the doc to the wormer for wormizing
246 warn "Starting worm session\n";
251 my $wreq = $session->request( "open-ils.worm.wormize", $docid );
258 warn "wormizing failed, rolling back\n";
259 OpenILS::Application::AppUtils->rollback_db_session($session);
261 if($e) { throw $e ($e); }
262 throw OpenSRF::EX::ERROR ("Wormizing Failed for $docid" );
265 warn "Committing db session...\n";
266 OpenILS::Application::AppUtils->commit_db_session( $session );
268 $nodeset = OpenILS::Utils::FlatXML->new()->xmldoc_to_nodeset($marcxml);
269 $tree = $utils->nodeset2tree($nodeset->nodeset);
270 $tree->owner_doc($docid);
272 # $client->respond_complete($tree);
274 warn "Done wormizing\n";
277 #warn "Returning tree:\n";
286 __PACKAGE__->register_method(
287 method => "biblio_record_record_metadata",
288 api_name => "open-ils.cat.biblio.record.metadata.retrieve",
289 argc => 1, #(session_id, biblio_tree )
290 notes => "Walks the tree and commits any changed nodes " .
291 "adds any new nodes, and deletes any deleted nodes",
294 sub biblio_record_record_metadata {
295 my( $self, $client, @ids ) = @_;
297 if(!@ids){return undef;}
299 my $session = OpenSRF::AppSession->create("open-ils.storage");
300 my $request = $session->request(
301 "open-ils.storage.direct.biblio.record_entry.batch.retrieve", @ids );
305 while( my $response = $request->recv() ) {
308 throw OpenSRF::EX::ERROR ("No Response from Storage");
310 if($response->isa("Error")) {
311 throw $response ($response->stringify);
314 my $record_entry = $response->content;
316 my $creator = $record_entry->creator;
317 my $editor = $record_entry->editor;
319 ($creator, $editor) = _get_userid_by_id($creator, $editor);
321 $record_entry->creator($creator);
322 $record_entry->editor($editor);
324 push @$results, $record_entry;
329 $session->disconnect();
337 sub _get_userid_by_id {
342 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
343 my $request = $session->request(
344 "open-ils.storage.direct.actor.user.batch.retrieve.atomic", @ids );
346 $request->wait_complete;
347 my $response = $request->recv();
348 if(!$request->complete) { return undef; }
350 if($response->isa("Error")){
351 throw $response ($response);
354 for my $u (@{$response->content}) {
356 push @users, $u->usrname;
360 $session->disconnect;
366 sub _get_id_by_userid {
371 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
372 my $request = $session->request(
373 "open-ils.storage.direct.actor.user.search.usrname.atomic", @users );
375 $request->wait_complete;
376 my $response = $request->recv();
377 if(!$request->complete) {
378 throw OpenSRF::EX::ERROR ("no response from storage on user retrieve");
381 if(UNIVERSAL::isa( $response, "Error")){
382 throw $response ($response);
385 for my $u (@{$response->content}) {
391 $session->disconnect;
398 # commits metadata objects to the db
399 sub _update_record_metadata {
401 my ($session, @docs ) = @_;
403 for my $doc (@docs) {
405 my $user_obj = $doc->{user};
406 my $docid = $doc->{docid};
408 warn "Updating metata for doc $docid\n";
410 my $request = $session->request(
411 "open-ils.storage.direct.biblio.record_entry.retrieve", $docid );
412 my $record = $request->gather(1);
414 warn "retrieved record\n";
415 my ($id) = _get_id_by_userid($user_obj->usrname);
417 warn "got $id from _get_id_by_userid\n";
418 $record->editor($id);
420 warn "Grabbed the record, updating and moving on\n";
422 $request = $session->request(
423 "open-ils.storage.direct.biblio.record_entry.update", $record );
427 warn "committing metarecord update\n";
434 __PACKAGE__->register_method(
435 method => "orgs_for_title",
436 api_name => "open-ils.cat.actor.org_unit.retrieve_by_title"
440 my( $self, $client, $record_id ) = @_;
442 my $vols = $apputils->simple_scalar_request(
444 "open-ils.storage.direct.asset.call_number.search.record.atomic",
447 my $orgs = { map {$_->owning_lib => 1 } @$vols };
448 return [ keys %$orgs ];
453 __PACKAGE__->register_method(
454 method => "retrieve_copies",
455 api_name => "open-ils.cat.asset.copy_tree.retrieve");
457 __PACKAGE__->register_method(
458 method => "retrieve_copies",
459 api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
461 # user_session may be null/undef
462 sub retrieve_copies {
464 my( $self, $client, $user_session, $docid, @org_ids ) = @_;
466 if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
470 warn " $$ retrieving copy tree for orgs @org_ids and doc $docid at " . time() . "\n";
472 # grabbing copy trees should be available for everyone..
473 if(!@org_ids and $user_session) {
475 OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
476 @org_ids = ($user_obj->home_ou);
479 if( $self->api_name =~ /global/ ) {
480 warn "performing global copy_tree search for $docid\n";
481 return _build_volume_list( { record => $docid } );
486 for my $orgid (@org_ids) {
487 my $vols = _build_volume_list(
488 { record => $docid, owning_lib => $orgid } );
489 warn "Volumes built for org $orgid\n";
490 push( @all_vols, @$vols );
493 warn " $$ Finished copy_tree at " . time() . "\n";
501 sub _build_volume_list {
502 my $search_hash = shift;
504 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
507 my $request = $session->request(
508 "open-ils.storage.direct.asset.call_number.search.atomic", $search_hash );
510 my $vols = $request->gather(1);
513 for my $volume (@$vols) {
515 warn "Grabbing copies for volume: " . $volume->id . "\n";
516 my $creq = $session->request(
517 "open-ils.storage.direct.asset.copy.search.call_number.atomic",
519 my $copies = $creq->gather(1);
521 $volume->copies($copies);
523 push( @volumes, $volume );
527 $session->disconnect();
533 # -----------------------------------------------------------------
534 # Fleshed volume tree batch add/update. This does everything a
535 # volume tree could want, add, update, delete
536 # -----------------------------------------------------------------
537 __PACKAGE__->register_method(
538 method => "volume_tree_fleshed_update",
539 api_name => "open-ils.cat.asset.volume_tree.fleshed.batch.update",
541 sub volume_tree_fleshed_update {
543 my( $self, $client, $user_session, $volumes ) = @_;
544 return undef unless $volumes;
546 my $user_obj = $apputils->check_user_session($user_session);
549 my $session = $apputils->start_db_session();
550 warn "Looping on volumes in fleshed volume tree update\n";
552 # cycle through the volumes provided and update/create/delete where necessary
553 for my $volume (@$volumes) {
555 warn "updating volume " . $volume->id . "\n";
557 my $update_copy_list = $volume->copies;
560 if( $volume->isdeleted) {
561 my $status = _delete_volume($session, $volume, $user_obj);
563 throw OpenSRF::EX::ERROR
564 ("Volume delete failed for volume " . $volume->id);
566 if(UNIVERSAL::isa($status, "OpenILS::Perm")) { return $status; }
568 } elsif( $volume->isnew ) {
571 $volume->editor($user_obj->id);
572 $volume->creator($user_obj->id);
573 $volume = _add_volume($session, $volume, $user_obj);
574 if($volume and UNIVERSAL::isa($volume, "OpenILS::Perm")) { return $volume; }
576 } elsif( $volume->ischanged ) {
578 $volume->editor($user_obj->id);
579 my $stat = _update_volume($session, $volume, $user_obj);
580 if($stat and UNIVERSAL::isa($stat, "OpenILS::Perm")) { return $stat; }
584 if( ! $volume->isdeleted ) {
585 for my $copy (@{$update_copy_list}) {
587 $copy->editor($user_obj->id);
588 warn "updating copy for volume " . $volume->id . "\n";
593 $copy->call_number($volume->id);
594 $copy->creator($user_obj->id);
595 $copy = _fleshed_copy_update($session,$copy,$user_obj->id);
597 } elsif( $copy->ischanged ) {
598 $copy->call_number($volume->id);
599 $copy = _fleshed_copy_update($session, $copy, $user_obj->id);
601 } elsif( $copy->isdeleted ) {
602 warn "Deleting copy " . $copy->id . " for volume " . $volume->id . "\n";
603 my $status = _fleshed_copy_update($session, $copy, $user_obj->id);
604 warn "Copy delete returned a status of $status\n";
610 $apputils->commit_db_session($session);
611 return scalar(@$volumes);
616 my( $session, $volume, $user_obj ) = @_;
618 if($apputils->check_user_perms(
619 $user_obj->id, $user_obj->home_ou, "DELETE_VOLUME")) {
620 return OpenILS::Perm->new("DELETE_VOLUME"); }
622 #$volume = _find_volume($session, $volume);
623 warn "Deleting volume " . $volume->id . "\n";
625 my $copies = $session->request(
626 "open-ils.storage.direct.asset.copy.search.call_number.atomic",
627 $volume->id )->gather(1);
629 throw OpenSRF::EX::ERROR
630 ("Cannot remove volume with copies attached");
633 my $req = $session->request(
634 "open-ils.storage.direct.asset.call_number.delete",
636 return $req->gather(1);
641 my($session, $volume, $user_obj) = @_;
642 if($apputils->check_user_perms(
643 $user_obj->id, $user_obj->home_ou, "UPDATE_VOLUME")) {
644 return OpenILS::Perm->new("UPDATE_VOLUME"); }
646 my $req = $session->request(
647 "open-ils.storage.direct.asset.call_number.update",
649 my $status = $req->gather(1);
654 my($session, $volume, $user_obj) = @_;
656 if($apputils->check_user_perms(
657 $user_obj->id, $user_obj->home_ou, "CREATE_VOLUME")) {
658 return OpenILS::Perm->new("CREATE_VOLUME"); }
660 my $request = $session->request(
661 "open-ils.storage.direct.asset.call_number.create", $volume );
663 my $id = $request->gather(1);
666 OpenILS::Application::AppUtils->rollback_db_session($session);
667 throw OpenSRF::EX::ERROR (" * -> Error creating new volume");
671 warn "received new volume id: $id\n";
679 __PACKAGE__->register_method(
680 method => "fleshed_copy_update",
681 api_name => "open-ils.cat.asset.copy.fleshed.batch.update",
684 sub fleshed_copy_update {
685 my($self, $client, $user_session, $copies) = @_;
687 my $user_obj = $apputils->check_user_session($user_session);
688 my $session = $apputils->start_db_session();
690 for my $copy (@$copies) {
691 _fleshed_copy_update($session, $copy, $user_obj);
694 $apputils->commit_db_session($session);
701 my($session, $copy, $user_obj) = @_;
703 if($apputils->check_user_perms(
704 $user_obj->id, $user_obj->home_ou, "DELETE_COPY")) {
705 return OpenILS::Perm->new("DELETE_COPY"); }
707 warn "Deleting copy " . $copy->id . "\n";
708 my $request = $session->request(
709 "open-ils.storage.direct.asset.copy.delete",
711 return $request->gather(1);
715 my($session, $copy, $user_obj) = @_;
717 if($apputils->check_user_perms(
718 $user_obj->id, $user_obj->home_ou, "CREATE_COPY")) {
719 return OpenILS::Perm->new("CREATE_COPY"); }
721 my $request = $session->request(
722 "open-ils.storage.direct.asset.copy.create",
724 my $id = $request->gather(1);
727 throw OpenSRF::EX::ERROR
728 ("Unable to create new copy " . Dumper($copy));
731 warn "Created copy " . $copy->id . "\n";
738 my($session, $copy, $user_obj) = @_;
740 if($apputils->check_user_perms(
741 $user_obj->id, $user_obj->home_ou, "UPDATE_COPY")) {
742 return OpenILS::Perm->new("UPDATE_COPY"); }
744 my $request = $session->request(
745 "open-ils.storage.direct.asset.copy.update", $copy );
746 my $status = $request->gather(1);
747 warn "Updated copy " . $copy->id . "\n";
752 # -----------------------------------------------------------------
753 # Creates/Updates/Deletes a fleshed asset.copy.
754 # adds/deletes copy stat_cat maps where necessary
755 # -----------------------------------------------------------------
756 sub _fleshed_copy_update {
757 my($session, $copy, $editor) = @_;
759 my $stat_cat_entries = $copy->stat_cat_entries;
760 $copy->editor($editor->id);
762 # in case we're fleshed
763 if(ref($copy->status)) {$copy->status( $copy->status->id ); }
764 if(ref($copy->location)) {$copy->location( $copy->location->id ); }
765 if(ref($copy->circ_lib)) {$copy->circ_lib( $copy->circ_lib->id ); }
767 warn "Updating copy " . Dumper($copy) . "\n";
769 if( $copy->isdeleted ) {
770 return _delete_copy($session, $copy, $editor);
771 } elsif( $copy->isnew ) {
772 $copy = _create_copy($session, $copy, $editor);
773 } elsif( $copy->ischanged ) {
774 _update_copy($session, $copy, $editor);
778 if(!@$stat_cat_entries) { return 1; }
780 my $stat_maps = $session->request(
781 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.search.owning_copy.atomic",
782 $copy->id )->gather(1);
784 if(!$copy->isnew) { _delete_stale_maps($session, $stat_maps, $copy); }
786 # go through the stat cat update/create process
787 for my $stat_entry (@{$stat_cat_entries}){
788 _copy_update_stat_cats( $session, $copy, $stat_maps, $stat_entry, $editor );
795 # -----------------------------------------------------------------
796 # Deletes stat maps attached to this copy in the database that
797 # are no longer attached to the current copy
798 # -----------------------------------------------------------------
799 sub _delete_stale_maps {
800 my( $session, $stat_maps, $copy) = @_;
802 warn "Deleting stale stat maps for copy " . $copy->id . "\n";
803 for my $map (@$stat_maps) {
804 # if there is no stat cat entry on the copy who's id matches the
805 # current map's id, remove the map from the database
806 if(! grep { $_->id == $map->stat_cat_entry } @{$copy->stat_cat_entries} ) {
807 my $req = $session->request(
808 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.delete", $map );
817 # -----------------------------------------------------------------
818 # Searches the stat maps to see if '$entry' already exists on
819 # the given copy. If it does not, a new stat map is created
820 # for the given entry and copy
821 # -----------------------------------------------------------------
822 sub _copy_update_stat_cats {
823 my ( $session, $copy, $stat_maps, $entry, $editor ) = @_;
825 warn "Updating stat maps for copy " . $copy->id . "\n";
827 # see if this map already exists
828 for my $map (@$stat_maps) {
829 if( $map->stat_cat_entry == $entry->id ) {return;}
832 warn "Creating new stat map for stat " .
833 $entry->stat_cat . " and copy " . $copy->id . "\n";
836 my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
838 $new_map->stat_cat( $entry->stat_cat );
839 $new_map->stat_cat_entry( $entry->id );
840 $new_map->owning_copy( $copy->id );
842 warn "New map is " . Dumper($new_map) . "\n";
844 my $request = $session->request(
845 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.create",
847 my $status = $request->gather(1);
848 warn "created new map with id $status\n";