From 47879808611511f8db11b5f3d6831151543531bd Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Tue, 27 Nov 2012 10:42:58 -0500
Subject: [PATCH] SIP hold cancellation support

Implement a subset of SIP message pair 15/16 for holds cancellation.

1. New oils_sip.xml configuration option "msg64_hold_datatype".  This
is similar to msg64_summary_datatype, but affacts holds instead of
circulations.  When set to 'barcode', holds information will be
delivered as a set of copy barcodes instead of title strings for patron
info requests.  With barcodes, SIP clients can both find the title
strings for display (via item info requests) and make subseqent
hold-related action requests, like holds cancellation.

--
Copies are not an ideal identifier for holds, but SIP has a limited
vocabulary.  With copies we can (99% of the time) work to and from hold
requests to find a reasonable data set to work on.  If a patron has
multiple holds for the same item and wants to cancel a specific one of
those holds, the user should use the catalog instead of SIP.
--

2. When receiving a message 15 of with a cancellation action, find the
newest open hold that matches the provided copy barcode and cancel the
hold.

Signed-off-by: Bill Erickson <berick@esilibrary.com>
Signed-off-by: Mike Rylander <mrylander@gmail.com>
---
 Open-ILS/examples/oils_sip.xml.example        |  11 ++
 Open-ILS/src/perlmods/lib/OpenILS/SIP.pm      | 111 ++++++-----
 .../src/perlmods/lib/OpenILS/SIP/Patron.pm    | 183 ++++++++++++++----
 .../lib/OpenILS/SIP/Transaction/Hold.pm       |  73 +++++++
 4 files changed, 284 insertions(+), 94 deletions(-)
 create mode 100644 Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Hold.pm

diff --git a/Open-ILS/examples/oils_sip.xml.example b/Open-ILS/examples/oils_sip.xml.example
index c986ca1c91..ee371526df 100644
--- a/Open-ILS/examples/oils_sip.xml.example
+++ b/Open-ILS/examples/oils_sip.xml.example
@@ -99,6 +99,17 @@
 					  default behaviour in previous versions of Evergreen.
 					-->
 					<option name='msg64_summary_datatype' value='barcode' />
+
+
+                    <!--
+                        When set, holds will be returned to the SIP client as copy
+                        barcodes instead of title strings.  This is useful, in 
+                        particular, for making subsequent calls for hold cancellation.  
+                    -->
+                    <!--
+                    <option name='msg64_hold_datatype' value='barcode' />
+                    -->
+
 					<!--
 						If enabled, the PC field in patron-info requests will return the non-translated profile name
 					<option name='patron_type_uses_code' value='true' />
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm
index 2e5f3f183a..46c902a6e7 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm
@@ -16,6 +16,7 @@ use OpenILS::SIP::Transaction::Checkin;
 use OpenILS::SIP::Transaction::Renew;
 use OpenILS::SIP::Transaction::RenewAll;
 use OpenILS::SIP::Transaction::FeePayment;
+use OpenILS::SIP::Transaction::Hold;
 
 use OpenSRF::System;
 use OpenSRF::AppSession;
@@ -553,63 +554,59 @@ sub pay_fee {
 #    return $trans;
 #}
 #
-#sub cancel_hold {
-#    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
-#    my ($patron, $item, $hold);
-#    my $trans;
-#
-#    $trans = new ILS::Transaction::Hold;
-#
-#    # BEGIN TRANSACTION
-#    $patron = new ILS::Patron $patron_id;
-#    if (!$patron) {
-#    $trans->screen_msg("Invalid patron barcode.");
-#
-#    return $trans;
-#    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
-#    $trans->screen_msg('Invalid patron password.');
-#
-#    return $trans;
-#    }
-#
-#    $item = new ILS::Item ($item_id || $title_id);
-#    if (!$item) {
-#    $trans->screen_msg("No such item.");
-#
-#    # END TRANSACTION (conditionally)
-#    return $trans;
-#    }
-#
-#    # Remove the hold from the patron's record first
-#    $trans->ok($patron->drop_hold($item_id));
-#
-#    if (!$trans->ok) {
-#    # We didn't find it on the patron record
-#    $trans->screen_msg("No such hold on patron record.");
-#
-#    # END TRANSACTION (conditionally)
-#    return $trans;
-#    }
-#
-#    # Now, remove it from the item record.  If it was on the patron
-#    # record but not on the item record, we'll treat that as success.
-#    foreach my $i (0 .. scalar @{$item->hold_queue}) {
-#    $hold = $item->hold_queue->[$i];
-#
-#    if ($hold->{patron_id} eq $patron->id) {
-#        # found it: delete it.
-#        splice @{$item->hold_queue}, $i, 1;
-#        last;
-#    }
-#    }
-#
-#    $trans->screen_msg("Hold Cancelled.");
-#    $trans->patron($patron);
-#    $trans->item($item);
-#
-#    return $trans;
-#}
-#
+
+# Note: item_id in this context is the hold id
+sub cancel_hold {
+    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
+
+    my $trans = OpenILS::SIP::Transaction::Hold->new(authtoken => $self->{authtoken});
+    my $patron = $self->find_patron($patron_id);
+
+    if (!$patron) {
+        $trans->screen_msg("Invalid patron barcode.");
+        $trans->ok(0);
+        return $trans;
+    }
+
+    if (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
+        $trans->screen_msg('Invalid patron password.');
+        $trans->ok(0);
+        return $trans;
+    }
+
+    $trans->patron($patron);
+    my $hold = $patron->find_hold_from_copy($item_id);
+
+    if (!$hold) {
+        syslog('LOG_WARNING', "OILS: No hold found from copy $item_id");
+        $trans->screen_msg("No such hold.");
+        $trans->ok(0);
+        return $trans;
+    }
+
+    if ($hold->usr ne $patron->{user}->id) {
+        $trans->screen_msg("No such hold on patron record.");
+        $trans->ok(0);
+        return $trans;
+    }
+
+    $trans->hold($hold);
+    $trans->do_hold_cancel($self);
+
+    if ($trans->cancel_ok) {
+        $trans->screen_msg("Hold Cancelled.");
+    } else {
+        $trans->screen_msg("Hold was not cancelled.");
+    }
+
+    # if the hold had no current_copy, use the representative
+    # item as the item for the hold.  Without this, the SIP 
+    # server gets angry.
+    $trans->item($self->find_item($item_id)) unless $trans->item;
+
+    return $trans;
+}
+
 #
 ## The patron and item id's can't be altered, but the
 ## date, location, and type can.
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm
index a3b0f85aaa..13870af831 100644
--- a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm
@@ -459,18 +459,159 @@ sub hold_items {
     my ($self, $start, $end) = @_;
     syslog('LOG_DEBUG', 'OILS: Patron->hold_items()');
 
-     my $holds = $self->{editor}->search_action_hold_request(
-        { usr => $self->{user}->id, fulfillment_time => undef, cancel_time => undef }
-     );
+     # all of my open holds
+     my $holds = $self->{editor}->search_action_hold_request({ 
+        usr => $self->{user}->id, 
+        fulfillment_time => undef, 
+        cancel_time => undef 
+    });
+
+     return $self->__format_holds($holds, $start, $end);
+}
+
+sub unavail_holds {
+     my ($self, $start, $end) = @_;
+     syslog('LOG_DEBUG', 'OILS: Patron->unavail_holds()');
+
+     my $holds = $self->{editor}->search_action_hold_request({
+        usr => $self->{user}->id,
+        fulfillment_time => undef,
+        cancel_time => undef,
+        '-or' => [
+            {current_shelf_lib => undef},
+            {current_shelf_lib => {'!=' => {'+ahr' => 'pickup_lib'}}}
+        ]
+    });
+
+    return $self->__format_holds($holds, $start, $end);
+}
+
+
+
+sub __format_holds {
+    my ($self, $holds, $start, $end) = @_;
+
+    return [] unless @$holds;
 
-    my @holds;
-    push( @holds, OpenILS::SIP::clean_text($self->__hold_to_title($_)) ) for @$holds;
+    my $return_datatype = 
+        OpenILS::SIP->get_option_value('msg64_hold_datatype') || '';
+
+    my @response;
+
+    for my $hold (@$holds) {
+
+        if ($return_datatype eq 'barcode') {
+
+            if (my $copy = $self->find_copy_for_hold($hold)) {
+                push(@response, $copy->barcode);
+
+            } else {
+                syslog('LOG_WARNING', 
+                    'OILS: No representative copy found for hold ' . $hold->id);
+            }
+
+        } else {
+            push(@response, 
+                OpenILS::SIP::clean_text($self->__hold_to_title($hold)));
+        }
+    }
 
     return (defined $start and defined $end) ? 
         [ @holds[($start-1)..($end-1)] ] :
         \@holds;
 }
 
+# Finds a representative copy for the given hold.
+# If no copy exists at all, undef is returned.
+# The only limit placed on what constitutes a 
+# "representative" copy is that it cannot be deleted.
+# Otherwise, any copy that allows us to find the hold
+# later is good enough.
+sub find_copy_for_hold {
+    my ($self, $hold) = @_;
+    my $e = $self->{editor};
+
+    return $e->retrieve_asset_copy($hold->current_copy)
+        if $hold->current_copy; 
+
+    return $e->retrieve_asset_copy($hold->target)
+        if $hold->hold_type =~ /C|R|F/;
+
+    return $e->search_asset_copy([
+        {call_number => $hold->target, deleted => 'f'}, 
+        {limit => 1}])->[0] if $hold->hold_type eq 'V';
+
+    my $bre_ids = [$hold->target];
+
+    if ($hold->hold_type eq 'M') {
+        # find all of the bibs that link to the target metarecord
+        my $maps = $e->search_metabib_metarecord_source_map(
+            {metarecord => $hold->target});
+        $bre_ids = [map {$_->record} @$maps];
+    }
+
+    my $vol_ids = $e->search_asset_call_number( 
+        {record => $bre_ids, deleted => 'f'}, 
+        {idlist => 1}
+    );
+
+    return $e->search_asset_copy([
+        {call_number => $vol_ids, deleted => 'f'}, 
+        {limit => 1}
+    ])->[0];
+}
+
+# Given a "representative" copy, finds a matching hold
+sub find_hold_from_copy {
+    my ($self, $barcode) = @_;
+    my $e = $self->{editor};
+    my $hold;
+
+    my $copy = $e->search_asset_copy([
+        {barcode => $barcode, deleted => 'f'},
+        {flesh => 1, flesh_fields => {acp => ['call_number']}}
+    ])->[0];
+
+    return undef unless $copy;
+
+    my $run_hold_query = sub {
+        my %filter = @_;
+        return $e->search_action_hold_request([
+            {   usr => $self->{user}->id,
+                cancel_time => undef,
+                fulfillment_time => undef,
+                %filter
+            }, {
+                limit => 1,
+                order_by => {ahr => 'request_time DESC'}
+            }
+        ])->[0];
+    };
+
+    # first see if there is a match on current_copy
+    return $hold if $hold = 
+        $run_hold_query->(current_copy => $copy->id);
+
+    # next, assume bib-level holds are the most common
+    return $hold if $hold = $run_hold_query->(
+        target => $copy->call_number->record, hold_type => 'T');
+
+    # next try metarecord holds
+    my $map = $e->search_metabib_metarecord_source_map(
+        {source => $copy->call_number->record})->[0];
+
+    return $hold if $hold = $run_hold_query->(
+        target => $map->metarecord, hold_type => 'M');
+
+    # volume holds
+    return $hold if $hold = $run_hold_query->(
+        target => $copy->call_number->id, hold_type => 'V');
+
+    # copy holds
+    return $run_hold_query->(
+        target => $copy->id, hold_type => ['C', 'F', 'R']);
+}
+
 sub __hold_to_title {
     my $self = shift;
     my $hold = shift;
@@ -655,38 +796,6 @@ sub recall_items {
     return [];
 }
 
-sub unavail_holds {
-     my ($self, $start, $end) = @_;
-     syslog('LOG_DEBUG', 'OILS: Patron->unavail_holds()');
-
-     my $ids = $self->{editor}->json_query({
-        select => {ahr => ['id']},
-        from => 'ahr',
-        where => {
-            usr => $self->{user}->id,
-            fulfillment_time => undef,
-            cancel_time => undef,
-            '-or' => [
-                {current_shelf_lib => undef},
-                {current_shelf_lib => {'!=' => {'+ahr' => 'pickup_lib'}}}
-            ]
-        }
-    });
- 
-     my @holds_sip_output;
-     @holds_sip_output = map {
-        OpenILS::SIP::clean_text($self->__hold_to_title($_))
-     } @{
-        $self->{editor}->search_action_hold_request(
-            {id => [map {$_->{id}} @$ids]}
-        )
-     } if (@$ids > 0);
- 
-     return (defined $start and defined $end) ?
-         [ @holds_sip_output[($start-1)..($end-1)] ] :
-         \@holds_sip_output;
-}
-
 sub block {
     my ($self, $card_retained, $blocked_card_msg) = @_;
     $blocked_card_msg ||= '';
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Hold.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Hold.pm
new file mode 100644
index 0000000000..61198bd0f3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Hold.pm
@@ -0,0 +1,73 @@
+package OpenILS::SIP::Transaction::Hold;
+use warnings; use strict;
+
+use Sys::Syslog qw(syslog);
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+our @ISA = qw(OpenILS::SIP::Transaction);
+
+my %fields = (
+    cancel_ok => 0,
+    hold => undef
+);
+
+sub new {
+    my $class = shift;;
+    my $self = $class->SUPER::new(@_);
+
+    $self->{_permitted}->{$_} = $fields{$_} for keys %fields;
+    @{$self}{keys %fields} = values %fields;
+
+    return bless $self, $class;
+}
+
+sub do_hold_cancel {
+    my $self = shift;
+    my $sip  = shift;
+
+    my $resp = $U->simplereq(
+        'open-ils.circ',
+        'open-ils.circ.hold.cancel', $self->{authtoken},
+        $self->hold->id, 7 # cancel via SIP
+    );
+
+    if( my $code = $U->event_code($resp) ) {
+        syslog('LOG_INFO', "OILS: Hold cancel failed with event $code : " . $resp->{textcode});
+        $self->cancel_ok(0);
+        $self->ok(0);
+        return $self;
+    }
+
+    syslog('LOG_INFO', "OILS: Hold cancellation succeeded for hold " . $self->hold->id);
+
+    $self->cancel_ok(1);
+    $self->ok(1);
+
+    $self->item($sip->find_item($self->hold->current_copy->barcode))
+        if $self->hold->current_copy;
+
+    return $self;
+}
+
+sub queue_position {
+    # cancelled holds have no queue position
+    return undef;
+}
+
+sub pickup_location {
+    # cancelled holds have no pickup location
+    return undef;
+}
+
+sub expiration_date {
+    # cancelled holds have no pickup location
+    return undef;
+}
+
+
+
+
+1;
-- 
2.43.2