LP#1619703 Transfer ACQ lineitem to alternate bib WIP

Signed-off-by: Bill Erickson <berickxx@gmail.com>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
index 7b1aebb..b613177 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
@@ -4167,13 +4167,13 @@ __PACKAGE__->register_method(
             {desc => 'The lineitem id', type => 'number'},
             {desc => 'The target bib record id', type => 'number'},
         ],
-        return => {desc => q/1 on success, event on error/}
+        return => {desc => q/Updated lineitem on success, event on error/}
     }
 );
 
 sub transfer_lineitem {
     my($self, $conn, $auth, $li_id, $bib_id, $ops) = @_;
-    $ops ||= {}; # reserved for later use (e.g. holds transfer)
+    $ops ||= {}; # future use
 
     my $e = new_editor(authtoken=>$auth, xact=>1);
     return $e->die_event unless $e->checkauth;
@@ -4181,6 +4181,14 @@ sub transfer_lineitem {
     my ($li, $evt, $perm_org) = fetch_and_check_li($e, $li_id, 'write');
     return $evt if $evt;
 
+    my $orig_bib_id = $li->eg_bib_id; # capture for later.
+
+    if ($orig_bib_id eq $bib_id) {
+        # Transferring to the same bib.  Nothing to do.
+        $e->rollback;
+        return $li;
+    }
+
     # Sanity check the target bib.
     
     my $bre = $e->retrieve_biblio_record_entry($bib_id) 
@@ -4196,7 +4204,6 @@ sub transfer_lineitem {
     # work even if the lineitem is not currently pointing at any bib
     # record.  IOW, this could be used to manually link LI's to bibs.
 
-    my $orig_bib_id = $li->eg_bib_id; # capture for later.
     $li->eg_bib_id($bib_id);
     $li->edit_time('now');
     $li->editor($e->requestor->id);
@@ -4205,8 +4212,8 @@ sub transfer_lineitem {
 
     # Transfer any asset.call_number's (with their linked asset.copy's) 
     # that were created for this lineitem to the new bib record.
-    my $lid_ids = $e->json_query({
-        select => {acqlid => ['id']},
+    my $acp_ids = $e->json_query({
+        select => {acqlid => ['eg_copy_id']},
         from => 'acqlid',
         where => {lineitem => $li_id}
     });
@@ -4216,15 +4223,96 @@ sub transfer_lineitem {
     # copies are moving.
     # TODO: Transfer monograph parts.
 
-    for my $lid_id (map { $_->{id} } @$lid_ids) {
+    my $copies = $e->search_asset_copy(
+        {id => [map {$_->{eg_copy_id}} @$acp_ids]},
+        {substream => 1}
+    );
 
-        my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
+    # Group copies into call number batches so each call number can
+    # be assessed and processed once.
+    my %cn_batches;
+    for my $copy (@$copies) {
+        my $cn_id = $copy->call_number;
+        $cn_batches{$cn_id} = [] unless $cn_batches{$cn_id};
+        push(@{$cn_batches{$cn_id}}, $copy);
+    }
 
+    while (my ($cn_id, $cn_copies) = each %cn_batches) {
+        my $evt = transfer_order_volume($e, $bib_id, $cn_id, $cn_copies);
+        return $evt if $evt;
     }
 
     $e->commit;
 
-    return 1;
+    return $li;
+}
+
+# 1. If every copy linked to the CN is represented by ordered copies
+# -- the ones we're processing here -- then transfer the call number
+# wholesale to the new bib record.
+#
+# 2. Otherwise, find-or-create a like call number for the target
+# bib record and update the ordered copies to use the new/found
+# call number.
+#
+# Returns undef on success, event on error.
+sub transfer_order_volume {
+    my ($e, $bib_id, $cn_id, $cn_copies) = @_;
+
+    my $cn = $e->retrieve_asset_call_number($cn_id) or return $e->die_event;
+
+    my $copy_count = $e->json_query({
+        select => {acp => [{
+            aggregate => 1, 
+            transform => 'count',
+            column => 'id'
+        }]},
+        from => 'acp',
+        where => {call_number => $cn_id}
+    });
+
+    my $target_cn;
+    my $evt;
+
+    if ($copy_count->{count} == scalar(@$cn_copies)) {
+        # Order copies represent all copies linked to the callnumber
+        # See if a matching CN exists at the target bib and, if so,
+        # transfer our copies to the existing CN.  Otherwise,
+        # simply point our call number at the new bib.
+
+        # See if a matching CN already exists at the target bib
+        $target_cn = OpenILS::Application::Cat::AssetCommon->volume_exists(
+            $e, $bib_id, $cn->label, $cn->owning_lib, $cn->prefix, $cn->suffix
+        );
+
+        if (!$target_cn) {
+            # No matching CN exists.  Point our CN at the target bib.
+            $cn->record($bib_id);
+            $cn->edit_date('now');
+            $cn->editor($e->requestor->id);
+            $e->update_asset_call_number($cn) or return $e->die_event;
+            return undef; # all done
+        }
+    }
+
+    ($target_cn, $evt) = 
+        OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
+            $e, $cn->label, $bib_id, $cn->owning_lib, 
+            $cn->prefix, $cn->suffix, $cn->label_class
+        ) unless $target_cn;
+
+    return $evt if $evt;
+
+    # ... transfer copies.
+    # Transfer order copies to the new call number.
+    for my $copy ($cn_copies) {
+        $copy->call_number($target_cn->id);
+        $copy->edit_date('now');
+        $copy->editor($e->requestor->id);
+        $e->update_asset_copy($copy) or return $e->die_event;
+    }
+
+    return undef;
 }