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;}
97 warn "Record import with tcn: $tcn and source $tcn_source\n";
99 my $record = Fieldmapper::biblio::record_entry->new;
101 $record->source($source);
102 $record->tcn_source($tcn_source);
103 $record->tcn_value($tcn);
104 $record->creator($user_obj->id);
105 $record->editor($user_obj->id);
106 $record->marc($copy_marcxml->toString);
109 my $req = $session->request(
110 "open-ils.storage.direct.biblio.record_entry.create", $record );
112 my $id = $req->gather(1);
114 if(!$id) { throw OpenSRF::EX::ERROR ("Unable to create new record_entry from import"); }
115 warn "received id: $id from record_entry create\n";
117 $apputils->commit_db_session($session);
119 $session = OpenSRF::AppSession->create("open-ils.storage");
121 my $wreq = $session->request("open-ils.worm.wormize", $id)->gather(1);
122 warn "Done worming record $id\n";
124 if(!$wreq) { throw OpenSRF::EX::ERROR ("Unable to wormize imported record"); }
126 return $self->biblio_record_tree_retrieve($client, $id);
134 if(!$tcn) {return 0;}
136 my $req = $session->request(
137 "open-ils.storage.direct.biblio.record_entry.search.tcn_value.atomic",
139 my $recs = $req->gather(1);
141 if($recs and $recs->[0]) {
149 __PACKAGE__->register_method(
150 method => "biblio_record_tree_retrieve",
151 api_name => "open-ils.cat.biblio.record.tree.retrieve",
154 sub biblio_record_tree_retrieve {
156 my( $self, $client, $recordid ) = @_;
158 my $name = "open-ils.storage.direct.biblio.record_entry.retrieve";
159 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
160 my $request = $session->request( $name, $recordid );
161 my $marcxml = $request->gather(1);
164 throw OpenSRF::EX::ERROR
165 ("No record in database with id $recordid");
168 $session->disconnect();
171 warn "turning into nodeset\n";
172 my $nodes = OpenILS::Utils::FlatXML->new()->xml_to_nodeset( $marcxml->marc );
173 warn "turning nodeset into tree\n";
174 my $tree = $utils->nodeset2tree( $nodes->nodeset );
176 $tree->owner_doc( $marcxml->id() );
178 warn "returning tree\n";
183 __PACKAGE__->register_method(
184 method => "biblio_record_tree_commit",
185 api_name => "open-ils.cat.biblio.record.tree.commit",
186 argc => 3, #(session_id, biblio_tree )
187 notes => <<" NOTES");
188 Walks the tree and commits any changed nodes
189 adds any new nodes, and deletes any deleted nodes
190 The record to commit must already exist or this
194 sub biblio_record_tree_commit {
196 my( $self, $client, $user_session, $tree ) = @_;
198 throw OpenSRF::EX::InvalidArg
199 ("Not enough args to to open-ils.cat.biblio.record.tree.commit")
200 unless ( $user_session and $tree );
202 my $user_obj = $apputils->check_user_session($user_session);
204 if($apputils->check_user_perms(
205 $user_obj->id, $user_obj->home_ou, "UPDATE_MARC")) {
206 return OpenILS::Perm->new("UPDATE_MARC");
211 my $docid = $tree->owner_doc();
212 my $session = OpenILS::Application::AppUtils->start_db_session();
214 warn "Retrieving biblio record from storage for update\n";
216 my $req1 = $session->request(
217 "open-ils.storage.direct.biblio.record_entry.batch.retrieve", $docid );
218 my $biblio = $req1->gather(1);
220 warn "retrieved doc $docid\n";
223 # turn the tree into a nodeset
224 my $nodeset = $utils->tree2nodeset($tree);
225 $nodeset = $utils->clean_nodeset($nodeset);
227 if(!defined($docid)) { # be sure
228 for my $node (@$nodeset) {
229 $docid = $node->owner_doc();
230 last if defined($docid);
234 # turn the nodeset into a doc
235 my $marcxml = OpenILS::Utils::FlatXML->new()->nodeset_to_xml( $nodeset );
237 $biblio->marc( $marcxml->toString() );
239 warn "Starting db session\n";
241 my $x = _update_record_metadata( $session, { user => $user_obj, docid => $docid } );
242 OpenILS::Application::AppUtils->rollback_db_session($session) unless $x;
244 warn "Sending updated doc $docid to db\n";
245 my $req = $session->request( "open-ils.storage.direct.biblio.record_entry.update", $biblio );
248 my $status = $req->recv();
249 if( !$status || $status->isa("Error") || ! $status->content) {
250 OpenILS::Application::AppUtils->rollback_db_session($session);
251 if($status->isa("Error")) { throw $status ($status); }
252 throw OpenSRF::EX::ERROR ("Error updating biblio record");
256 # Send the doc to the wormer for wormizing
257 warn "Starting worm session\n";
262 my $wreq = $session->request( "open-ils.worm.wormize", $docid );
269 warn "wormizing failed, rolling back\n";
270 OpenILS::Application::AppUtils->rollback_db_session($session);
272 if($e) { throw $e ($e); }
273 throw OpenSRF::EX::ERROR ("Wormizing Failed for $docid" );
276 warn "Committing db session...\n";
277 OpenILS::Application::AppUtils->commit_db_session( $session );
279 $nodeset = OpenILS::Utils::FlatXML->new()->xmldoc_to_nodeset($marcxml);
280 $tree = $utils->nodeset2tree($nodeset->nodeset);
281 $tree->owner_doc($docid);
283 # $client->respond_complete($tree);
285 warn "Done wormizing\n";
288 #warn "Returning tree:\n";
297 __PACKAGE__->register_method(
298 method => "biblio_record_record_metadata",
299 api_name => "open-ils.cat.biblio.record.metadata.retrieve",
300 argc => 1, #(session_id, biblio_tree )
301 notes => "Walks the tree and commits any changed nodes " .
302 "adds any new nodes, and deletes any deleted nodes",
305 sub biblio_record_record_metadata {
306 my( $self, $client, @ids ) = @_;
308 if(!@ids){return undef;}
310 my $session = OpenSRF::AppSession->create("open-ils.storage");
311 my $request = $session->request(
312 "open-ils.storage.direct.biblio.record_entry.batch.retrieve", @ids );
316 while( my $response = $request->recv() ) {
319 throw OpenSRF::EX::ERROR ("No Response from Storage");
321 if($response->isa("Error")) {
322 throw $response ($response->stringify);
325 my $record_entry = $response->content;
327 my $creator = $record_entry->creator;
328 my $editor = $record_entry->editor;
330 ($creator, $editor) = _get_userid_by_id($creator, $editor);
332 $record_entry->creator($creator);
333 $record_entry->editor($editor);
335 push @$results, $record_entry;
340 $session->disconnect();
348 sub _get_userid_by_id {
353 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
354 my $request = $session->request(
355 "open-ils.storage.direct.actor.user.batch.retrieve.atomic", @ids );
357 $request->wait_complete;
358 my $response = $request->recv();
359 if(!$request->complete) { return undef; }
361 if($response->isa("Error")){
362 throw $response ($response);
365 for my $u (@{$response->content}) {
367 push @users, $u->usrname;
371 $session->disconnect;
377 sub _get_id_by_userid {
382 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
383 my $request = $session->request(
384 "open-ils.storage.direct.actor.user.search.usrname.atomic", @users );
386 $request->wait_complete;
387 my $response = $request->recv();
388 if(!$request->complete) {
389 throw OpenSRF::EX::ERROR ("no response from storage on user retrieve");
392 if(UNIVERSAL::isa( $response, "Error")){
393 throw $response ($response);
396 for my $u (@{$response->content}) {
402 $session->disconnect;
409 # commits metadata objects to the db
410 sub _update_record_metadata {
412 my ($session, @docs ) = @_;
414 for my $doc (@docs) {
416 my $user_obj = $doc->{user};
417 my $docid = $doc->{docid};
419 warn "Updating metata for doc $docid\n";
421 my $request = $session->request(
422 "open-ils.storage.direct.biblio.record_entry.retrieve", $docid );
423 my $record = $request->gather(1);
425 warn "retrieved record\n";
426 my ($id) = _get_id_by_userid($user_obj->usrname);
428 warn "got $id from _get_id_by_userid\n";
429 $record->editor($id);
431 warn "Grabbed the record, updating and moving on\n";
433 $request = $session->request(
434 "open-ils.storage.direct.biblio.record_entry.update", $record );
438 warn "committing metarecord update\n";
445 __PACKAGE__->register_method(
446 method => "orgs_for_title",
447 api_name => "open-ils.cat.actor.org_unit.retrieve_by_title"
451 my( $self, $client, $record_id ) = @_;
453 my $vols = $apputils->simple_scalar_request(
455 "open-ils.storage.direct.asset.call_number.search.record.atomic",
458 my $orgs = { map {$_->owning_lib => 1 } @$vols };
459 return [ keys %$orgs ];
464 __PACKAGE__->register_method(
465 method => "retrieve_copies",
466 api_name => "open-ils.cat.asset.copy_tree.retrieve");
468 __PACKAGE__->register_method(
469 method => "retrieve_copies",
470 api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
472 # user_session may be null/undef
473 sub retrieve_copies {
475 my( $self, $client, $user_session, $docid, @org_ids ) = @_;
477 if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
481 warn " $$ retrieving copy tree for orgs @org_ids and doc $docid at " . time() . "\n";
483 # grabbing copy trees should be available for everyone..
484 if(!@org_ids and $user_session) {
486 OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
487 @org_ids = ($user_obj->home_ou);
490 if( $self->api_name =~ /global/ ) {
491 warn "performing global copy_tree search for $docid\n";
492 return _build_volume_list( { record => $docid } );
497 for my $orgid (@org_ids) {
498 my $vols = _build_volume_list(
499 { record => $docid, owning_lib => $orgid } );
500 warn "Volumes built for org $orgid\n";
501 push( @all_vols, @$vols );
504 warn " $$ Finished copy_tree at " . time() . "\n";
512 sub _build_volume_list {
513 my $search_hash = shift;
515 my $session = OpenSRF::AppSession->create( "open-ils.storage" );
518 my $request = $session->request(
519 "open-ils.storage.direct.asset.call_number.search.atomic", $search_hash );
521 my $vols = $request->gather(1);
524 for my $volume (@$vols) {
526 warn "Grabbing copies for volume: " . $volume->id . "\n";
527 my $creq = $session->request(
528 "open-ils.storage.direct.asset.copy.search.call_number.atomic", $volume->id );
530 my $copies = $creq->gather(1);
532 $copies = [ sort { $a->barcode cmp $b->barcode } @$copies ];
534 $volume->copies($copies);
536 push( @volumes, $volume );
540 $session->disconnect();
546 # -----------------------------------------------------------------
547 # Fleshed volume tree batch add/update. This does everything a
548 # volume tree could want, add, update, delete
549 # -----------------------------------------------------------------
550 __PACKAGE__->register_method(
551 method => "volume_tree_fleshed_update",
552 api_name => "open-ils.cat.asset.volume_tree.fleshed.batch.update",
554 sub volume_tree_fleshed_update {
556 my( $self, $client, $user_session, $volumes ) = @_;
557 return undef unless $volumes;
559 my $user_obj = $apputils->check_user_session($user_session);
562 my $session = $apputils->start_db_session();
563 warn "Looping on volumes in fleshed volume tree update\n";
565 # cycle through the volumes provided and update/create/delete where necessary
566 for my $volume (@$volumes) {
568 warn "updating volume " . $volume->id . "\n";
570 my $update_copy_list = $volume->copies;
573 if( $volume->isdeleted) {
574 my $status = _delete_volume($session, $volume, $user_obj);
576 throw OpenSRF::EX::ERROR
577 ("Volume delete failed for volume " . $volume->id);
579 if(UNIVERSAL::isa($status, "Fieldmapper::perm_ex")) { return $status; }
581 } elsif( $volume->isnew ) {
584 $volume->editor($user_obj->id);
585 $volume->creator($user_obj->id);
586 $volume = _add_volume($session, $volume, $user_obj);
589 if($volume and UNIVERSAL::isa($volume, "Fieldmapper::perm_ex")) { return $volume; }
591 } elsif( $volume->ischanged ) {
593 $volume->editor($user_obj->id);
594 my $stat = _update_volume($session, $volume, $user_obj);
595 if($stat and UNIVERSAL::isa($stat, "Fieldmapper::perm_ex")) { return $stat; }
599 if( ! $volume->isdeleted ) {
600 for my $copy (@{$update_copy_list}) {
602 $copy->editor($user_obj->id);
603 warn "updating copy for volume " . $volume->id . "\n";
608 $copy->call_number($volume->id);
609 $copy->creator($user_obj->id);
610 $copy = _fleshed_copy_update($session,$copy,$user_obj);
612 } elsif( $copy->ischanged ) {
613 $copy->call_number($volume->id);
614 $copy = _fleshed_copy_update($session, $copy, $user_obj);
616 } elsif( $copy->isdeleted ) {
617 warn "Deleting copy " . $copy->id . " for volume " . $volume->id . "\n";
618 my $status = _fleshed_copy_update($session, $copy, $user_obj);
619 warn "Copy delete returned a status of $status\n";
625 $apputils->commit_db_session($session);
626 return scalar(@$volumes);
631 my( $session, $volume, $user_obj ) = @_;
633 if($apputils->check_user_perms(
634 $user_obj->id, $user_obj->home_ou, "DELETE_VOLUME")) {
635 return OpenILS::Perm->new("DELETE_VOLUME"); }
637 #$volume = _find_volume($session, $volume);
638 warn "Deleting volume " . $volume->id . "\n";
640 my $copies = $session->request(
641 "open-ils.storage.direct.asset.copy.search.call_number.atomic",
642 $volume->id )->gather(1);
644 throw OpenSRF::EX::ERROR
645 ("Cannot remove volume with copies attached");
648 my $req = $session->request(
649 "open-ils.storage.direct.asset.call_number.delete",
651 return $req->gather(1);
656 my($session, $volume, $user_obj) = @_;
657 if($apputils->check_user_perms(
658 $user_obj->id, $user_obj->home_ou, "UPDATE_VOLUME")) {
659 return OpenILS::Perm->new("UPDATE_VOLUME"); }
661 my $req = $session->request(
662 "open-ils.storage.direct.asset.call_number.update",
664 my $status = $req->gather(1);
669 my($session, $volume, $user_obj) = @_;
671 if($apputils->check_user_perms(
672 $user_obj->id, $user_obj->home_ou, "CREATE_VOLUME")) {
673 warn "User does not have priveleges to create new volumes\n";
674 return OpenILS::Perm->new("CREATE_VOLUME");
677 my $request = $session->request(
678 "open-ils.storage.direct.asset.call_number.create", $volume );
680 my $id = $request->gather(1);
683 OpenILS::Application::AppUtils->rollback_db_session($session);
684 throw OpenSRF::EX::ERROR (" * -> Error creating new volume");
688 warn "received new volume id: $id\n";
696 __PACKAGE__->register_method(
697 method => "fleshed_copy_update",
698 api_name => "open-ils.cat.asset.copy.fleshed.batch.update",
701 sub fleshed_copy_update {
702 my($self, $client, $user_session, $copies) = @_;
704 my $user_obj = $apputils->check_user_session($user_session);
705 my $session = $apputils->start_db_session();
707 for my $copy (@$copies) {
708 _fleshed_copy_update($session, $copy, $user_obj);
711 $apputils->commit_db_session($session);
718 my($session, $copy, $user_obj) = @_;
720 if($apputils->check_user_perms(
721 $user_obj->id, $user_obj->home_ou, "DELETE_COPY")) {
722 return OpenILS::Perm->new("DELETE_COPY"); }
724 warn "Deleting copy " . $copy->id . "\n";
725 my $request = $session->request(
726 "open-ils.storage.direct.asset.copy.delete",
728 return $request->gather(1);
732 my($session, $copy, $user_obj) = @_;
734 if($apputils->check_user_perms(
735 $user_obj->id, $user_obj->home_ou, "CREATE_COPY")) {
736 return OpenILS::Perm->new("CREATE_COPY"); }
738 my $request = $session->request(
739 "open-ils.storage.direct.asset.copy.create",
741 my $id = $request->gather(1);
744 throw OpenSRF::EX::ERROR
745 ("Unable to create new copy " . Dumper($copy));
748 warn "Created copy " . $copy->id . "\n";
755 my($session, $copy, $user_obj) = @_;
757 if($apputils->check_user_perms(
758 $user_obj->id, $user_obj->home_ou, "UPDATE_COPY")) {
759 return OpenILS::Perm->new("UPDATE_COPY"); }
761 my $request = $session->request(
762 "open-ils.storage.direct.asset.copy.update", $copy );
763 my $status = $request->gather(1);
764 warn "Updated copy " . $copy->id . "\n";
769 # -----------------------------------------------------------------
770 # Creates/Updates/Deletes a fleshed asset.copy.
771 # adds/deletes copy stat_cat maps where necessary
772 # -----------------------------------------------------------------
773 sub _fleshed_copy_update {
774 my($session, $copy, $editor) = @_;
776 my $stat_cat_entries = $copy->stat_cat_entries;
777 $copy->editor($editor->id);
779 # in case we're fleshed
780 if(ref($copy->status)) {$copy->status( $copy->status->id ); }
781 if(ref($copy->location)) {$copy->location( $copy->location->id ); }
782 if(ref($copy->circ_lib)) {$copy->circ_lib( $copy->circ_lib->id ); }
784 warn "Updating copy " . Dumper($copy) . "\n";
786 if( $copy->isdeleted ) {
787 return _delete_copy($session, $copy, $editor);
788 } elsif( $copy->isnew ) {
789 $copy = _create_copy($session, $copy, $editor);
790 } elsif( $copy->ischanged ) {
791 _update_copy($session, $copy, $editor);
795 if(!@$stat_cat_entries) { return 1; }
797 my $stat_maps = $session->request(
798 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.search.owning_copy.atomic",
799 $copy->id )->gather(1);
801 if(!$copy->isnew) { _delete_stale_maps($session, $stat_maps, $copy); }
803 # go through the stat cat update/create process
804 for my $stat_entry (@{$stat_cat_entries}){
805 _copy_update_stat_cats( $session, $copy, $stat_maps, $stat_entry, $editor );
812 # -----------------------------------------------------------------
813 # Deletes stat maps attached to this copy in the database that
814 # are no longer attached to the current copy
815 # -----------------------------------------------------------------
816 sub _delete_stale_maps {
817 my( $session, $stat_maps, $copy) = @_;
819 warn "Deleting stale stat maps for copy " . $copy->id . "\n";
820 for my $map (@$stat_maps) {
821 # if there is no stat cat entry on the copy who's id matches the
822 # current map's id, remove the map from the database
823 if(! grep { $_->id == $map->stat_cat_entry } @{$copy->stat_cat_entries} ) {
824 my $req = $session->request(
825 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.delete", $map );
834 # -----------------------------------------------------------------
835 # Searches the stat maps to see if '$entry' already exists on
836 # the given copy. If it does not, a new stat map is created
837 # for the given entry and copy
838 # -----------------------------------------------------------------
839 sub _copy_update_stat_cats {
840 my ( $session, $copy, $stat_maps, $entry, $editor ) = @_;
842 warn "Updating stat maps for copy " . $copy->id . "\n";
844 # see if this map already exists
845 for my $map (@$stat_maps) {
846 if( $map->stat_cat_entry == $entry->id ) {return;}
849 warn "Creating new stat map for stat " .
850 $entry->stat_cat . " and copy " . $copy->id . "\n";
853 my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
855 $new_map->stat_cat( $entry->stat_cat );
856 $new_map->stat_cat_entry( $entry->id );
857 $new_map->owning_copy( $copy->id );
859 warn "New map is " . Dumper($new_map) . "\n";
861 my $request = $session->request(
862 "open-ils.storage.direct.asset.stat_cat_entry_copy_map.create",
864 my $status = $request->gather(1);
865 warn "created new map with id $status\n";