Use 'noop' checkin for check_in_item()
[sitka/iNCIPit.git] / iNCIPit.cgi
CommitLineData
4cdc4f67
JS
1#! /usr/bin/perl
2
3eefadf9 3#
30820396 4# Copyleft 2014 Jon Scott <mr.jonathon.scott@gmail.com>
613812b0 5# Copyleft 2014 Mark Cooper <mark.c.cooper@outlook.com>
3eefadf9
JG
6# Copyright 2012-2013 Midwest Consortium for Library Services
7# Copyright 2013 Calvin College
8# contact Dan Wells <dbw2@calvin.edu>
9# Copyright 2013 Traverse Area District Library,
10# contact Jeff Godin <jgodin@tadl.org>
11#
12#
13# This code incorporates code (with modifications) from issa, "a small
14# command-line client to OpenILS/Evergreen". issa is licensed GPLv2 or (at your
15# option) any later version of the GPL.
16#
17# issa is copyright:
18#
19# Copyright 2011 Jason J.A. Stephenson <jason@sigio.com>
20# Portions Copyright 2012 Merrimack Valley Library Consortium
21# <jstephenson@mvlc.org>
22#
23#
1ac548f2 24# This file is part of iNCIPit
4cdc4f67
JS
25#
26# iNCIPit is free software: you can redistribute it and/or modify it
27# under the terms of the GNU General Public License as published by
28# the Free Software Foundation, either version 2 of the License, or
29# (at your option) any later version.
30#
31# iNCIPit is distributed in the hope that it will be useful, but WITHOUT
32# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
33# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
34# License for more details.
35#
36# You should have received a copy of the GNU General Public License
7a94033c 37# along with iNCIPit. If not, see <http://www.gnu.org/licenses/>.
4cdc4f67 38
4cdc4f67 39use warnings;
9061228c 40use strict;
4cdc4f67 41use XML::LibXML;
7c5a71b2 42use XML::LibXML::ErrNo;
8ed2a2d4 43use CGI;
4cdc4f67
JS
44use HTML::Entities;
45use CGI::Carp;
4cdc4f67
JS
46use OpenSRF::System;
47use OpenSRF::Utils::SettingsClient;
48use Digest::MD5 qw/md5_hex/;
49use OpenILS::Utils::Fieldmapper;
50use OpenILS::Utils::CStoreEditor qw/:funcs/;
51use OpenILS::Const qw/:const/;
52use Scalar::Util qw(reftype blessed);
53use MARC::Record;
54use MARC::Field;
55use MARC::File::XML;
56use POSIX qw/strftime/;
57use DateTime;
f5e8d07e
JG
58use Config::Tiny;
59
a30f6f9e 60my $U = "OpenILS::Application::AppUtils";
4cdc4f67 61
02bc01c4
JS
62my $cgi = CGI->new();
63my $xml = $cgi->param('POSTDATA');# || $cgi->param('XForms:Model');
64my $host = $cgi->url(-base=>1);
613812b0
MC
65my $hostname = (split "/", $host)[2]; # base hostname i.e. www.example.org
66my $conffile = "$hostname.ini"; # hostname specific ini file i.e. www.example.org.ini
67my $conf;
02bc01c4 68
613812b0
MC
69# attempt to load configuration file using matching request hostname, fallback to default
70if (-e $conffile) {
71 $conf = load_config($conffile);
72} else {
73 $conffile = "iNCIPit.ini";
74 $conf = load_config($conffile);
75}
f5e8d07e 76
b9103e62 77# Set some variables from config (or defaults)
b9103e62 78
d2c6645e
JG
79# Default patron_identifier type is barcode
80my $patron_id_type = "barcode";
81
82# if the config specifies a patron_identifier type
83if (my $conf_patron_id_type = $conf->{behavior}->{patron_identifier}) {
84 # and that patron_identifier type is known
85 if ($conf_patron_id_type =~ m/(barcode|id)/) {
86 # override the default with the value from the config
87 $patron_id_type = $conf_patron_id_type;
88 }
b9103e62
JG
89}
90
60d032c1 91# reject non-https access unless configured otherwise
a8c18053 92unless ($conf->{access}->{permit_plaintext} =~ m/^yes$/i) {
99da8d8a 93 unless (defined($ENV{HTTPS}) && $ENV{HTTPS} eq 'on') {
60d032c1 94 print "Content-type: text/plain\n\n";
86fda995
JG
95 print "Access denied.\n";
96 exit 0;
60d032c1
JG
97 }
98}
99
100# TODO: support for multiple load balancer IPs
101my $lb_ip = $conf->{access}->{load_balancer_ip};
102
103# if we are behind a load balancer, check to see that the
104# actual client IP is permitted
105if ($lb_ip) {
106 my @allowed_ips = split(/ *, */, $conf->{access}->{allowed_client_ips});
107
86fda995
JG
108 my $forwarded = $ENV{HTTP_X_FORWARDED_FOR};
109 my $ok = 0;
60d032c1 110
86fda995
JG
111 foreach my $check_ip (@allowed_ips) {
112 $ok = 1 if ($check_ip eq $forwarded);
113 }
60d032c1
JG
114
115 # if we have a load balancer IP and are relying on
116 # X-Forwarded-For, deny requests other than those
117 # from the load balancer
118 # TODO: support for chained X-Forwarded-For -- ignore all but last
86fda995 119 unless ($ok && $ENV{REMOTE_ADDR} eq $lb_ip) {
60d032c1 120 print "Content-type: text/plain\n\n";
86fda995
JG
121 print "Access denied.\n";
122 exit 0;
123 }
60d032c1
JG
124}
125
4cdc4f67 126
613812b0 127# log request hostname, configuration file used and posted data
1ac548f2 128# XXX: posted ncip message log filename should be in config.
522c37d6 129open (POST_DATA, ">>post_data.txt") or die "Cannot write post_data.txt";
613812b0
MC
130print POST_DATA "INCOMING REQUEST\t$hostname\n";
131print POST_DATA "CONFIGURATION FILE\t$conffile\n";
132print POST_DATA "$xml\n";
4cdc4f67
JS
133close POST_DATA;
134
135# initialize the parser
136my $parser = new XML::LibXML;
314c09e9
JG
137my $doc;
138
139# Attempt to parse XML without any modification
140eval {
141 $doc = $parser->load_xml( string => $xml );
142};
143
b9e9ad63
JG
144# Attempt to gracefully handle invalid XML, including mitigations for known common issues.
145if ($@ && ref($@) ne 'XML::LibXML::Error') {
146 # We received an error, but it was not a LibXML error object
147 fail("Unknown error parsing XML: $@");
148} elsif ($@) {
149 # We received an error in the form of a LibXML error object
150
151 my $warning = sprintf("Unable to parse XML on the first try. LibXML error code: %s, message: %s", $@->code(), $@->message());
152 warn $warning;
153
154 # If the error was ERR_INVALID_CHAR, attempt to modify XML and try again
155 if ($@->code() == XML::LibXML::ErrNo::ERR_INVALID_CHAR) {
156
157 warn "Attempting to de-mangle by removing known invalid character(s).\n";
158
159 # This is based on actual invalid XML encountered in the wild
160 # in an INN-REACH environment.
161 $xml =~ s/\x04//g; # Remove ^D from xml
162
163 # Attempt to re-parse after de-mangling
164 eval {
165 $doc = $parser->load_xml( string => $xml );
166 };
167
168 if ($@ && ref($@) ne 'XML::LibXML::Error') {
169 # We received an error, but it was not a LibXML error object
170 fail("Unknown error parsing XML on second attempt: $@");
171 } elsif ($@) {
172 # We received an error in the form of a LibXML error object
173 my $error = sprintf("Unable to parse XML even after de-mangling. LibXML error code: %s, message: %s", $@->code(), $@->message());
174 fail($error);
175 }
176 warn "Success parsing XML after de-mangling.\n";
177 } else {
178 # This is not an error that we know how to recover from
179 fail("No known workaround for this error. Giving up.") unless $doc;
180 }
314c09e9
JG
181}
182
b9e9ad63 183fail("XML parsing did not result in a document.") unless $doc && ref($doc) eq 'XML::LibXML::Document';
4cdc4f67
JS
184
185my %session = login();
186
1ac548f2 187if ( defined( $session{authtoken} ) ) {
5f517e0a
DW
188 $doc->exists('/NCIPMessage/LookupUser') ? lookupUser() : (
189 $doc->exists('/NCIPMessage/ItemRequested') ? item_request() : (
190 $doc->exists('/NCIPMessage/ItemShipped') ? item_shipped() : (
191 $doc->exists('/NCIPMessage/ItemCheckedOut') ? item_checked_out() : (
192 $doc->exists('/NCIPMessage/CheckOutItem') ? check_out_item() : (
193 $doc->exists('/NCIPMessage/ItemCheckedIn') ? item_checked_in() : (
194 $doc->exists('/NCIPMessage/CheckInItem') ? check_in_item() : (
195 $doc->exists('/NCIPMessage/ItemReceived') ? item_received() : (
196 $doc->exists('/NCIPMessage/AcceptItem') ? accept_item() : (
197 $doc->exists('/NCIPMessage/ItemRequestCancelled') ? item_cancelled() : (
198 $doc->exists('/NCIPMessage/ItemRenewed') ? item_renew() : (
199 $doc->exists('/NCIPMessage/RenewItem') ? renew_item() :
200 fail("UNKNOWN NCIPMessage")
201 )))))))))));
202
5f517e0a 203 logout();
4cdc4f67 204} else {
5f517e0a 205 fail("Unable to perform action : Unknown Service Request");
4cdc4f67
JS
206}
207
f5e8d07e
JG
208# load and parse config file
209sub load_config {
210 my $file = shift;
211
212 my $Config = Config::Tiny->new;
213 $Config = Config::Tiny->read( $file ) ||
214 die( "Error reading config file ", $file, ": ", Config::Tiny->errstr, "\n" );
215 return $Config;
216}
217
47866eef 218# load and parse userpriv_map file, returning a hashref
3602ecf5 219sub load_map_file {
47866eef
JG
220 my $filename = shift;
221 my $map = {};
222 if (open(my $fh, "<", $filename)) {
223 while (my $entry = <$fh>) {
224 chomp($entry);
225 my ($from, $to) = split(m/:/, $entry);
226 $map->{$from} = $to;
227 }
228 close $fh;
229 }
230 return $map;
231}
232
233sub lookup_userpriv {
234 my $input = shift;
235 my $map = shift;
236 if (defined($map->{$input})) { # if we have a mapping for this profile
237 return $map->{$input}; # return value from mapping hash
238 } else {
239 return $input; # return original value
240 }
241}
242
3602ecf5
JG
243sub lookup_pickup_lib {
244 my $input = shift;
245 my $map = shift;
246 if (defined($map->{$input})) { # if we found this pickup lib
247 return $map->{$input}; # return value from mapping hash
248 } else {
249 return undef; # the original value does us no good -- return undef
250 }
251}
252
4cdc4f67 253sub logit {
5f517e0a 254 my ( $msg, $func, $more_info ) = @_;
522c37d6 255 open (RESP_DATA, ">>resp_data.txt") or die "Cannot write resp_data.txt";
5f517e0a
DW
256 print RESP_DATA $msg;
257 print RESP_DATA $more_info unless !$more_info;
258 close RESP_DATA;
259 print $msg || fail($func);
4cdc4f67
JS
260}
261
6e6bdfe9 262sub staff_log {
5f517e0a
DW
263 my ( $taiv, $faiv, $more_info ) = @_;
264 my $now = localtime();
522c37d6 265 open (STAFF_LOG, ">>staff_data.csv") or die "Cannot write staff_data.csv";
5f517e0a
DW
266 print STAFF_LOG "$now, $faiv, $taiv, $more_info\n";
267 close STAFF_LOG;
6e6bdfe9
JS
268}
269
4cdc4f67 270sub item_renew {
5f517e0a
DW
271 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
272 my $faidScheme = HTML::Entities::encode($faidSchemeX);
273 my $faidValue = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
274 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
275 my $taidScheme = HTML::Entities::encode($taidSchemeX);
276 my $taidValue = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
277
278 my $pid = $doc->findvalue('/NCIPMessage/ItemRenewed/UniqueUserId/UserIdentifierValue');
279 my $visid = $doc->findvalue('/NCIPMessage/ItemRenewed/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
280 my $due_date = $doc->findvalue('/NCIPMessage/ItemRenewed/DateDue');
281
282 my $r = renewal( $visid, $due_date );
283
284 my $hd = <<ITEMRENEWAL;
4cdc4f67
JS
285Content-type: text/xml
286
287
288<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
289<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
290 <ItemRenewedResponse>
291 <ResponseHeader>
292 <FromAgencyId>
293 <UniqueAgencyId>
294 <Scheme>$faidScheme</Scheme>
295 <Value>$faidValue</Value>
296 </UniqueAgencyId>
297 </FromAgencyId>
298 <ToAgencyId>
299 <UniqueAgencyId>
300 <Scheme>$taidScheme</Scheme>
301 <Value>$taidValue</Value>
302 </UniqueAgencyId>
303 </ToAgencyId>
304 </ResponseHeader>
305 <UniqueItemId>
306 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
307 </UniqueItemId>
308 </ItemRenewedResponse>
4cdc4f67
JS
309</NCIPMessage>
310
311ITEMRENEWAL
312
5f517e0a 313 my $more_info = <<MOREINFO;
4cdc4f67 314
5f517e0a
DW
315VISID = $visid
316Desired Due Date = $due_date
4cdc4f67
JS
317
318MOREINFO
319
5f517e0a
DW
320 logit( $hd, ( caller(0) )[3], $more_info );
321 staff_log( $taidValue, $faidValue,
322 "ItemRenewal -> Patronid : "
323 . $pid
324 . " | Visid : "
325 . $visid
326 . " | Due Date : "
327 . $due_date );
6e6bdfe9 328}
4cdc4f67 329
6e6bdfe9 330sub renew_item {
5f517e0a
DW
331 my $faidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
332 my $faidScheme = HTML::Entities::encode($faidSchemeX);
333 my $faidValue = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
334 my $taidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
335 my $taidScheme = HTML::Entities::encode($taidSchemeX);
336 my $taidValue = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
337
338 my $pid = $doc->findvalue('/NCIPMessage/RenewItem/UniqueUserId/UserIdentifierValue');
fd19ff1c 339 my $unique_item_id = $doc->findvalue('/NCIPMessage/RenewItem/UniqueItemId/ItemIdentifierValue');
cf85e982 340 my $due_date = $doc->findvalue('/NCIPMessage/RenewItem/DesiredDateDue');
5f517e0a 341
fd19ff1c
JG
342 # we are using the UniqueItemId value as a barcode here
343 my $r = renewal( $unique_item_id, $due_date );
5f517e0a
DW
344
345 my $hd = <<ITEMRENEWAL;
6e6bdfe9
JS
346Content-type: text/xml
347
348
349<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
350<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
351 <RenewItemResponse>
352 <ResponseHeader>
353 <FromAgencyId>
354 <UniqueAgencyId>
355 <Scheme>$faidScheme</Scheme>
356 <Value>$faidValue</Value>
357 </UniqueAgencyId>
358 </FromAgencyId>
359 <ToAgencyId>
360 <UniqueAgencyId>
361 <Scheme>$taidScheme</Scheme>
362 <Value>$taidValue</Value>
363 </UniqueAgencyId>
364 </ToAgencyId>
365 </ResponseHeader>
366 <UniqueItemId>
fd19ff1c 367 <ItemIdentifierValue datatype="string">$unique_item_id</ItemIdentifierValue>
5f517e0a
DW
368 </UniqueItemId>
369 </RenewItemResponse>
6e6bdfe9
JS
370</NCIPMessage>
371
372ITEMRENEWAL
373
5f517e0a 374 my $more_info = <<MOREINFO;
6e6bdfe9 375
fd19ff1c 376UNIQUEID = $unique_item_id
5f517e0a 377Desired Due Date = $due_date
6e6bdfe9
JS
378
379MOREINFO
380
5f517e0a
DW
381 logit( $hd, ( caller(0) )[3], $more_info );
382 staff_log( $taidValue, $faidValue,
383 "RenewItem -> Patronid : "
384 . $pid
fd19ff1c
JG
385 . " | Uniqueid: : "
386 . $unique_item_id
5f517e0a
DW
387 . " | Due Date : "
388 . $due_date );
4cdc4f67
JS
389}
390
391sub accept_item {
5f517e0a
DW
392 my $faidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
393 my $faidScheme = HTML::Entities::encode($faidSchemeX);
394 my $faidValue = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
395 my $taidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
396 my $taidScheme = HTML::Entities::encode($taidSchemeX);
397 my $taidValue = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
5f517e0a
DW
398 my $visid = $doc->findvalue('/NCIPMessage/AcceptItem/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
399 my $request_id = $doc->findvalue('/NCIPMessage/AcceptItem/UniqueRequestId/RequestIdentifierValue') || "unknown";
400 my $patron = $doc->findvalue('/NCIPMessage/AcceptItem/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
401 my $copy = copy_from_barcode($visid);
bf70b77d 402 fail( "accept_item: " . $copy->{textcode} . " $visid" ) unless ( blessed $copy);
ba01d5da 403 my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
272651d1
JG
404 # We need to find the hold to know the pickup location
405 my $hold = find_hold_on_copy($visid);
67f5b308
JG
406 if (defined $hold && blessed($hold)) {
407 # Check the copy in to capture for hold -- do it at the pickup_lib
408 # so that the hold becomes Available
409 my $checkin_result = checkin_accept($copy->id, $hold->pickup_lib);
410 } else {
411 fail( "accept_item: no hold found for visid " . $visid );
412 }
5f517e0a
DW
413
414 my $hd = <<ACCEPTITEM;
4cdc4f67
JS
415Content-type: text/xml
416
417
418<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
419<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
420 <AcceptItemResponse>
421 <ResponseHeader>
422 <FromAgencyId>
423 <UniqueAgencyId>
424 <Scheme>$faidScheme</Scheme>
425 <Value>$faidValue</Value>
426 </UniqueAgencyId>
427 </FromAgencyId>
428 <ToAgencyId>
429 <UniqueAgencyId>
430 <Scheme>$taidScheme</Scheme>
431 <Value>$taidValue</Value>
432 </UniqueAgencyId>
433 </ToAgencyId>
434 </ResponseHeader>
435 <UniqueRequestId>
436 <ItemIdentifierValue datatype="string">$request_id</ItemIdentifierValue>
437 </UniqueRequestId>
438 <UniqueItemId>
439 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
440 </UniqueItemId>
441 </AcceptItemResponse>
4cdc4f67
JS
442</NCIPMessage>
443
444ACCEPTITEM
445
5f517e0a
DW
446 logit( $hd, ( caller(0) )[3] );
447 staff_log( $taidValue, $faidValue,
0b0c5299 448 "AcceptItem -> Request Id : " . $request_id . " | Patron Id : " . $patron . " | Visible Id :" . $visid );
4cdc4f67
JS
449}
450
451sub item_received {
dfb584fc
JG
452 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
453 my $faidScheme = HTML::Entities::encode($faidSchemeX);
5f517e0a 454 my $faidValue = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
dfb584fc
JG
455 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
456 my $taidScheme = HTML::Entities::encode($taidSchemeX);
457 my $taidValue = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
0b0c5299
DW
458 my $visid = $doc->findvalue('/NCIPMessage/ItemReceived/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
459 my $copy = copy_from_barcode($visid);
460 fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
461 my $r1 = checkin($visid) if ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT ); # checkin the item before delete if ItemCheckedIn step was skipped
5f517e0a
DW
462 my $r2 = delete_copy($copy);
463
464 my $hd = <<ITEMRECEIVED;
4cdc4f67
JS
465Content-type: text/xml
466
467
468<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
469<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
470 <ItemReceivedResponse>
471 <ResponseHeader>
472 <FromAgencyId>
473 <UniqueAgencyId>
474 <Scheme>$faidScheme</Scheme>
475 <Value>$faidValue</Value>
476 </UniqueAgencyId>
477 </FromAgencyId>
478 <ToAgencyId>
479 <UniqueAgencyId>
480 <Scheme>$taidScheme</Scheme>
481 <Value>$taidValue</Value>
482 </UniqueAgencyId>
483 </ToAgencyId>
484 </ResponseHeader>
485 <UniqueItemId>
0b0c5299 486 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
5f517e0a
DW
487 </UniqueItemId>
488 </ItemReceivedResponse>
4cdc4f67
JS
489</NCIPMessage>
490
491ITEMRECEIVED
492
5f517e0a 493 logit( $hd, ( caller(0) )[3] );
0b0c5299 494 staff_log( $taidValue, $faidValue, "ItemReceived -> Visible ID : " . $visid );
4cdc4f67
JS
495}
496
497sub item_cancelled {
5f517e0a
DW
498 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
499 my $faidScheme = HTML::Entities::encode($faidSchemeX);
500 my $faidValue = $doc->find('/NCIPMessage/ItemRequestCancelled/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
501
502 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
503 my $taidScheme = HTML::Entities::encode($taidSchemeX);
504 my $taidValue = $doc->find('/NCIPMessage/ItemRequestCancelled/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
505 my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/UniqueItemId/UniqueAgencyId/Value');
506
507 my $barcode = $doc->findvalue('/NCIPMessage/ItemRequestCancelled/UniqueItemId/ItemIdentifierValue');
508
509 if ( $barcode =~ /^i/ ) { # delete copy only if barcode is an iNUMBER
510 $barcode .= $faidValue;
511 my $copy = copy_from_barcode($barcode);
512 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
513 my $r = delete_copy($copy);
514 } else {
5f517e0a 515 # remove hold!
b874ff79
DW
516 my $r = cancel_hold($barcode);
517 # TODO: check for any errors or unexpected return values in $r
5f517e0a
DW
518 my $copy = copy_from_barcode($barcode);
519 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
b874ff79
DW
520 $r = update_copy( $copy, 7 ); # set to reshelving (for wiggle room)
521 # TODO: check for any errors or unexpected return values in $r
522# XXX other options here could be:
523# - Set to 'available' (it is probably still on the shelf, though it might be in the process of being retrieved)
524# - Use checkin() here instead - This could trigger things we don't want to happen, though the 'noop' flag should catch at least some of that
525#
526# Also, presumably they cannot cancel once the item is in transit? If they can, we'll need more logic to decide what to do here.
5f517e0a
DW
527 }
528
529 my $hd = <<ITEMREQUESTCANCELLED;
4cdc4f67
JS
530Content-type: text/xml
531
532
533<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
534<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
535 <ItemRequestCancelledResponse>
536 <ResponseHeader>
537 <FromAgencyId>
538 <UniqueAgencyId>
539 <Scheme>$faidScheme</Scheme>
540 <Value>$faidValue</Value>
541 </UniqueAgencyId>
542 </FromAgencyId>
543 <ToAgencyId>
544 <UniqueAgencyId>
545 <Scheme>$taidScheme</Scheme>
546 <Value>$taidValue</Value>
547 </UniqueAgencyId>
548 </ToAgencyId>
549 </ResponseHeader>
550 <UniqueItemId>
551 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
552 </UniqueItemId>
553 </ItemRequestCancelledResponse>
4cdc4f67
JS
554</NCIPMessage>
555
556ITEMREQUESTCANCELLED
557
5f517e0a
DW
558 logit( $hd, ( caller(0) )[3] );
559 staff_log( $taidValue, $faidValue,
560 "ItemRequestCancelled -> Barcode : " . $barcode );
4cdc4f67
JS
561}
562
563sub item_checked_in {
5f517e0a
DW
564 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
565 my $faidScheme = HTML::Entities::encode($faidSchemeX);
566 my $faidValue = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
567 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
568 my $taidScheme = HTML::Entities::encode($taidSchemeX);
569 my $taidValue = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
570
0b0c5299
DW
571 my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedIn/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
572 my $r = checkin($visid);
573 my $copy = copy_from_barcode($visid);
574 fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
ba01d5da 575 my $r2 = update_copy( $copy, $conf->{status}->{transit_return} ); # "INN-Reach Transit Return" status
5f517e0a
DW
576
577 my $hd = <<ITEMCHECKEDIN;
4cdc4f67
JS
578Content-type: text/xml
579
580
581<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
582<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
583 <ItemCheckedInResponse>
584 <ResponseHeader>
585 <FromAgencyId>
586 <UniqueAgencyId>
587 <Scheme>$faidScheme</Scheme>
588 <Value>$faidValue</Value>
589 </UniqueAgencyId>
590 </FromAgencyId>
591 <ToAgencyId>
592 <UniqueAgencyId>
593 <Scheme>$taidScheme</Scheme>
594 <Value>$taidValue</Value>
595 </UniqueAgencyId>
596 </ToAgencyId>
597 </ResponseHeader>
598 <UniqueItemId>
0b0c5299 599 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
5f517e0a
DW
600 </UniqueItemId>
601 </ItemCheckedInResponse>
4cdc4f67
JS
602</NCIPMessage>
603
604ITEMCHECKEDIN
605
5f517e0a 606 logit( $hd, ( caller(0) )[3] );
0b0c5299 607 staff_log( $taidValue, $faidValue, "ItemCheckedIn -> Visible ID : " . $visid );
4cdc4f67
JS
608}
609
610sub item_checked_out {
5f517e0a
DW
611 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
612 my $faidScheme = HTML::Entities::encode($faidSchemeX);
613 my $faidValue = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
614 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
615 my $taidScheme = HTML::Entities::encode($taidSchemeX);
616 my $taidValue = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
617
0b0c5299 618 my $patron_barcode = $doc->findvalue('/NCIPMessage/ItemCheckedOut/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
5f517e0a 619 my $due_date = $doc->findvalue('/NCIPMessage/ItemCheckedOut/DateDue');
0b0c5299 620 my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedOut/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
5f517e0a
DW
621
622 my $copy = copy_from_barcode($visid);
623 fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
0b0c5299
DW
624 my $r = update_copy( $copy, 0 ); # seemed like copy had to be available before it could be checked out, so ...
625 my $r1 = checkin($visid) if ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT ); # double posted itemcheckedout messages cause error ... trying to simplify
626 my $r2 = checkout( $visid, $patron_barcode, $due_date );
5f517e0a
DW
627
628 my $hd = <<ITEMCHECKEDOUT;
4cdc4f67
JS
629Content-type: text/xml
630
631
632<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
633<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
634 <ItemCheckedOutResponse>
635 <ResponseHeader>
636 <FromAgencyId>
637 <UniqueAgencyId>
638 <Scheme>$faidScheme</Scheme>
639 <Value>$faidValue</Value>
640 </UniqueAgencyId>
641 </FromAgencyId>
642 <ToAgencyId>
643 <UniqueAgencyId>
644 <Scheme>$taidScheme</Scheme>
645 <Value>$taidValue</Value>
646 </UniqueAgencyId>
647 </ToAgencyId>
648 </ResponseHeader>
649 <UniqueItemId>
650 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
651 </UniqueItemId>
652 </ItemCheckedOutResponse>
4cdc4f67
JS
653</NCIPMessage>
654
655ITEMCHECKEDOUT
656
5f517e0a
DW
657 logit( $hd, ( caller(0) )[3] );
658 staff_log( $taidValue, $faidValue,
0b0c5299 659 "ItemCheckedOut -> Visible Id : " . $visid . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
4cdc4f67
JS
660}
661
662sub check_out_item {
5f517e0a
DW
663 my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
664 my $faidScheme = HTML::Entities::encode($faidSchemeX);
665 my $faidValue = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
666 my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
667 my $taidScheme = HTML::Entities::encode($taidSchemeX);
668 my $taidValue = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
669
670 my $mdate = $doc->findvalue('/NCIPMessage/CheckOutItem/MandatedAction/DateEventOccurred');
119c2c2f
JG
671 # TODO: look up individual accounts for agencies based on barcode prefix + agency identifier
672 my $patron_barcode = $conf->{checkout}->{institutional_patron}; # patron id if patron_id_as_identifier = yes
5f517e0a 673
04643d4b 674 # For CheckOutItem and INN-REACH, this value will correspond with our local barcode
5f517e0a 675 my $barcode = $doc->findvalue('/NCIPMessage/CheckOutItem/UniqueItemId/ItemIdentifierValue');
0b0c5299
DW
676
677 # TODO: watch for possible real ids here?
5f517e0a
DW
678 my $due_date = $doc->findvalue('/NCIPMessage/CheckOutItem/DateDue');
679
680 my $copy = copy_from_barcode($barcode);
681 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
682
0b0c5299
DW
683 my $r2 = checkout( $barcode, $patron_barcode, $due_date );
684
685 # TODO: check for checkout exception (like OPEN_CIRCULATION_EXISTS)
5f517e0a
DW
686
687 my $hd = <<CHECKOUTITEM;
4cdc4f67
JS
688Content-type: text/xml
689
690
691<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
692<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
693 <CheckOutItemResponse>
694 <ResponseHeader>
695 <FromAgencyId>
696 <UniqueAgencyId>
697 <Scheme>$faidScheme</Scheme>
698 <Value>$faidValue</Value>
699 </UniqueAgencyId>
700 </FromAgencyId>
701 <ToAgencyId>
702 <UniqueAgencyId>
703 <Scheme>$taidScheme</Scheme>
704 <Value>$taidValue</Value>
705 </UniqueAgencyId>
706 </ToAgencyId>
707 </ResponseHeader>
708 <UniqueItemId>
709 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
710 </UniqueItemId>
711 </CheckOutItemResponse>
4cdc4f67
JS
712</NCIPMessage>
713
714CHECKOUTITEM
715
5f517e0a
DW
716 logit( $hd, ( caller(0) )[3] );
717 staff_log( $taidValue, $faidValue,
0b0c5299 718 "CheckOutItem -> Barcode : " . $barcode . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
4cdc4f67
JS
719}
720
721sub check_in_item {
5f517e0a
DW
722 my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
723 my $faidScheme = HTML::Entities::encode($faidSchemeX);
724 my $faidValue = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
725 my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
726 my $taidScheme = HTML::Entities::encode($taidSchemeX);
727 my $taidValue = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
728
04643d4b 729 # For CheckInItem and INN-REACH, this value will correspond with our local barcode
5f517e0a 730 my $barcode = $doc->findvalue('/NCIPMessage/CheckInItem/UniqueItemId/ItemIdentifierValue');
d077d8de 731 my $r = checkin($barcode, 1);
2606eada
DW
732 fail($r) if $r =~ /^COPY_NOT_CHECKED_OUT/;
733 # TODO: do we need to do these next steps? checkin() should handle everything, and we want this to end up in 'reshelving'. If we are worried about transits, we should handle (abort) them, not just change the status
734 ##my $copy = copy_from_barcode($barcode);
735 ##fail($copy->{textcode}." $barcode") unless (blessed $copy);
736 ## my $r2 = update_copy($copy,0); # Available now
5f517e0a
DW
737
738 my $hd = <<CHECKINITEM;
4cdc4f67
JS
739Content-type: text/xml
740
741
742<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
743<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
744 <CheckInItemResponse>
745 <ResponseHeader>
746 <FromAgencyId>
747 <UniqueAgencyId>
748 <Scheme>$faidScheme</Scheme>
749 <Value>$faidValue</Value>
750 </UniqueAgencyId>
751 </FromAgencyId>
752 <ToAgencyId>
753 <UniqueAgencyId>
754 <Scheme>$taidScheme</Scheme>
755 <Value>$taidValue</Value>
756 </UniqueAgencyId>
757 </ToAgencyId>
758 </ResponseHeader>
759 <UniqueItemId>
760 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
761 </UniqueItemId>
762 </CheckInItemResponse>
4cdc4f67
JS
763</NCIPMessage>
764
765CHECKINITEM
766
5f517e0a
DW
767 logit( $hd, ( caller(0) )[3] );
768 staff_log( $taidValue, $faidValue, "CheckInItem -> Barcode : " . $barcode );
4cdc4f67
JS
769}
770
771sub item_shipped {
5f517e0a
DW
772 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
773 my $faidScheme = HTML::Entities::encode($faidSchemeX);
774 my $faidValue = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
775 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
776 my $taidScheme = HTML::Entities::encode($taidSchemeX);
777 my $taidValue = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
778
3602ecf5
JG
779 my $address = $doc->findvalue('/NCIPMessage/ItemShipped/ShippingInformation/PhysicalAddress/UnstructuredAddress/UnstructuredAddressData');
780
5f517e0a
DW
781 my $visid = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
782 my $barcode = $doc->findvalue('/NCIPMessage/ItemShipped/UniqueItemId/ItemIdentifierValue') . $faidValue;
783 my $title = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/BibliographicDescription/Title');
784 my $callnumber = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/CallNumber');
785
786 my $copy = copy_from_barcode($barcode);
3602ecf5 787
0a9f148c 788 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
b874cb1d 789
3602ecf5
JG
790 my $pickup_lib;
791
792 if ($address) {
793 my $pickup_lib_map = load_map_file( $conf->{path}->{pickup_lib_map} );
794
795 if ($pickup_lib_map) {
796 $pickup_lib = lookup_pickup_lib($address, $pickup_lib_map);
797 }
798 }
799
800 if ($pickup_lib) {
801 update_hold_pickup($barcode, $pickup_lib);
802 }
803
ba01d5da 804 my $r = update_copy_shipped( $copy, $conf->{status}->{transit}, $visid ); # put copy into INN-Reach Transit status & modify barcode = Visid != tempIIIiNumber
5f517e0a
DW
805
806 my $hd = <<ITEMSHIPPED;
4cdc4f67
JS
807Content-type: text/xml
808
809
810<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
811<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
812 <ItemShippedResponse>
813 <ResponseHeader>
814 <FromAgencyId>
815 <UniqueAgencyId>
816 <Scheme>$faidScheme</Scheme>
817 <Value>$faidValue</Value>
818 </UniqueAgencyId>
819 </FromAgencyId>
820 <ToAgencyId>
821 <UniqueAgencyId>
822 <Scheme>$taidScheme</Scheme>
823 <Value>$taidValue</Value>
824 </UniqueAgencyId>
825 </ToAgencyId>
826 </ResponseHeader>
827 <UniqueItemId>
828 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
829 </UniqueItemId>
830 </ItemShippedResponse>
4cdc4f67
JS
831</NCIPMessage>
832
833ITEMSHIPPED
834
5f517e0a
DW
835 logit( $hd, ( caller(0) )[3] );
836 staff_log( $taidValue, $faidValue,
0b0c5299 837 "ItemShipped -> Visible Id : " . $visid . " | Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber );
4cdc4f67
JS
838}
839
840sub item_request {
5f517e0a
DW
841 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
842 my $faidScheme = HTML::Entities::encode($faidSchemeX);
843 my $faidValue = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
844
845 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
846 my $taidScheme = HTML::Entities::encode($taidSchemeX);
847 my $taidValue = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
848 my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/UniqueAgencyId/Value');
849
0b0c5299
DW
850 # TODO: should we use the VisibleID for item agency variation of this method call
851
852 my $pid = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueUserId/UserIdentifierValue');
5f517e0a
DW
853 my $barcode = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/ItemIdentifierValue');
854 my $author = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Author');
855 my $title = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Title');
856 my $callnumber = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/ItemDescription/CallNumber');
857 my $medium_type = $doc->find('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/MediumType/Value');
858
859 my $r = "default error checking response";
860
a30f6f9e 861 if ( $barcode =~ /^i/ ) { # XXX EG is User Agency # create copy only if barcode is an iNUMBER
ba01d5da 862 my $copy_status_id = $conf->{status}->{loan_requested}; # INN-Reach Loan Requested - local configured status
5f517e0a 863 $barcode .= $faidValue;
a30f6f9e
DW
864 # we want our custom status to be then end result, so create the copy with status of "Available, then hold it, then update the status
865 $r = create_copy( $title, $callnumber, $barcode, 0, $medium_type );
866 my $copy = copy_from_barcode($barcode);
867 my $r2 = place_simple_hold( $copy->id, $pid );
868 my $r3 = update_copy( $copy, $copy_status_id );
869 } else { # XXX EG is Item Agency
15d084ee
JG
870 unless ( $conf->{behavior}->{no_item_agency_holds} =~ m/^y/i ) {
871 # place hold for user UniqueUserId/UniqueAgencyId/Value = institution account
872 my $copy = copy_from_barcode($barcode);
873 my $pid2 = 1013459; # XXX CUSTOMIZATION NEEDED XXX # this is the id of a user representing your DCB system, TODO: use agency information to create and link to individual accounts per agency, if needed
874 $r = place_simple_hold( $copy->id, $pid2 );
875 my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
876 }
5f517e0a
DW
877 }
878
ef5a5276 879 # Avoid generating invalid XML responses by encoding title/author/callnumber
20bfa6cb 880 # TODO: Move away from heredocs for generating XML
8b41455d
JG
881 $title = _naive_encode_xml($title);
882 $author = _naive_encode_xml($author);
883 $callnumber = _naive_encode_xml($callnumber);
20bfa6cb 884
5f517e0a 885 my $hd = <<ITEMREQ;
4cdc4f67
JS
886Content-type: text/xml
887
888
889<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
890<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
891 <ItemRequestedResponse>
892 <ResponseHeader>
893 <FromAgencyId>
894 <UniqueAgencyId>
895 <Scheme>$faidScheme</Scheme>
896 <Value>$faidValue</Value>
897 </UniqueAgencyId>
898 </FromAgencyId>
899 <ToAgencyId>
900 <UniqueAgencyId>
901 <Scheme>$taidScheme</Scheme>
902 <Value>$taidValue</Value>
903 </UniqueAgencyId>
904 </ToAgencyId>
905 </ResponseHeader>
906 <UniqueUserId>
907 <UniqueAgencyId>
908 <Scheme datatype="string">$taidScheme</Scheme>
909 <Value datatype="string">$taidValue</Value>
910 </UniqueAgencyId>
0b0c5299 911 <UserIdentifierValue datatype="string">$pid</UserIdentifierValue>
5f517e0a
DW
912 </UniqueUserId>
913 <UniqueItemId>
914 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
915 </UniqueItemId>
916 <ItemOptionalFields>
917 <BibliographicDescription>
918 <Author datatype="string">$author</Author>
919 <Title datatype="string">$title</Title>
920 </BibliographicDescription>
921 <ItemDescription>
922 <CallNumber datatype="string">$callnumber</CallNumber>
923 </ItemDescription>
924 </ItemOptionalFields>
925 </ItemRequestedResponse>
4cdc4f67
JS
926</NCIPMessage>
927
928ITEMREQ
929
5f517e0a
DW
930 logit( $hd, ( caller(0) )[3] );
931 staff_log( $taidValue, $faidValue,
0b0c5299 932 "ItemRequested -> Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber . " | Patronid :" . $pid );
4cdc4f67
JS
933}
934
1ac548f2
JS
935sub lookupUser {
936
5f517e0a
DW
937 my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
938 $faidScheme = HTML::Entities::encode($faidScheme);
939 my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
940 my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
941 $taidScheme = HTML::Entities::encode($taidScheme);
942
943 my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
944 my $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
b9103e62
JG
945
946 my $uidValue;
947
948 if ($patron_id_type eq 'barcode') {
949 $uidValue = user_id_from_barcode($id);
950 } else {
951 $uidValue = $id;
952 }
5f517e0a
DW
953
954 if ( !defined($uidValue)
955 || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
956 {
957 do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
958 die;
959 }
960
3bcdd8ae
JG
961 my ( $propername, $email, $good_until, $userpriv, $block_stanza ) =
962 ( "name here", "", "good until", "", "" ); # defaults
5f517e0a
DW
963
964 my $patron = flesh_user($uidValue);
965
966 #if (blessed($patron)) {
967 my $patron_ok = 1;
968 my @penalties = @{ $patron->standing_penalties };
969
970 if ( $patron->deleted eq 't' ) {
971 do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
972 die;
973 } elsif ( $patron->barred eq 't' ) {
974 do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
975 die;
976 } elsif ( $patron->active eq 'f' ) {
977 do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
978 die;
979 }
980
981 elsif ( $#penalties > -1 ) {
982
983# my $penalty;
984# foreach $penalty (@penalties) {
985# if (defined($penalty->standing_penalty->block_list)) {
986# my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
987# foreach my $block (@block_list) {
988# foreach my $block_on (@$block_types) {
989# if ($block eq $block_on) {
990# $block_stanza .= "\n".$penalty->standing_penalty->name;
991# $patron_ok = 0;
992# }
993# last unless ($patron_ok);
994# }
995# last unless ($patron_ok);
996# }
997# }
998# }
999 $block_stanza = qq(
1000 <BlockOrTrap>
1001 <UniqueAgencyId>
1002 <Scheme datatype="string">http://just.testing.now</Scheme>
1003 <Value datatype="string">$faidValue</Value>
1004 </UniqueAgencyId>
1005 <BlockOrTrapType>
1006 <Scheme datatype="string">http://just.testing.now</Scheme>
1007 <Value datatype="string">Block Hold</Value>
1008 </BlockOrTrapType>
1009 </BlockOrTrap>);
1010 }
1011
5809d230 1012 if ( defined( $patron->email ) && $conf->{behavior}->{omit_patron_email} !~ m/^y/i ) {
5f517e0a
DW
1013 $email = qq(
1014 <UserAddressInformation>
1015 <ElectronicAddress>
1016 <ElectronicAddressType>
1017 <Scheme datatype="string">http://testing.now</Scheme>
1018 <Value datatype="string">mailto</Value>
1019 </ElectronicAddressType>
1020 <ElectronicAddressData datatype="string">)
1021 . HTML::Entities::encode( $patron->email )
1022 . qq(</ElectronicAddressData>
1023 </ElectronicAddress>
1024 </UserAddressInformation>);
1025 }
1026
1027 $propername = $patron->first_given_name . " " . $patron->family_name;
1028 $good_until = $patron->expire_date || "unknown";
33a39c82 1029 $userpriv = $patron->profile->name;
5f517e0a 1030
3602ecf5 1031 my $userpriv_map = load_map_file( $conf->{path}->{userpriv_map} );
47866eef
JG
1032
1033 if ($userpriv_map) {
45d455be 1034 $userpriv = lookup_userpriv($userpriv, $userpriv_map);
47866eef
JG
1035 }
1036
5f517e0a
DW
1037 #} else {
1038 # do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
1039 # die;
1040 #}
0b0c5299 1041 my $uniqid = $patron->id;
b9103e62
JG
1042 my $visid;
1043 if ($patron_id_type eq 'barcode') {
1044 $visid = $patron->card->barcode;
1045 } else {
1046 $visid = $patron->id;
1047 }
5f517e0a 1048 my $hd = <<LOOKUPUSERRESPONSE;
4cdc4f67
JS
1049Content-type: text/xml
1050
1051
1052<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1053<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1054 <LookupUserResponse>
1055 <ResponseHeader>
1056 <FromAgencyId>
1057 <UniqueAgencyId>
1058 <Scheme>$taidScheme</Scheme>
1059 <Value>$taidValue</Value>
1060 </UniqueAgencyId>
1061 </FromAgencyId>
1062 <ToAgencyId>
1063 <UniqueAgencyId>
1064 <Scheme>$faidScheme</Scheme>
1065 <Value>$faidValue</Value>
1066 </UniqueAgencyId>
1067 </ToAgencyId>
1068 </ResponseHeader>
1069 <UniqueUserId>
1070 <UniqueAgencyId>
1071 <Scheme>$taidScheme</Scheme>
1072 <Value>$taidValue</Value>
1073 </UniqueAgencyId>
0b0c5299 1074 <UserIdentifierValue>$uniqid</UserIdentifierValue>
5f517e0a
DW
1075 </UniqueUserId>
1076 <UserOptionalFields>
1077 <VisibleUserId>
1078 <VisibleUserIdentifierType>
1079 <Scheme datatype="string">http://blah.com</Scheme>
1080 <Value datatype="string">Barcode</Value>
1081 </VisibleUserIdentifierType>
0b0c5299 1082 <VisibleUserIdentifier datatype="string">$visid</VisibleUserIdentifier>
5f517e0a
DW
1083 </VisibleUserId>
1084 <NameInformation>
1085 <PersonalNameInformation>
1086 <UnstructuredPersonalUserName datatype="string">$propername</UnstructuredPersonalUserName>
1087 </PersonalNameInformation>
1088 </NameInformation>
1089 <UserPrivilege>
1090 <UniqueAgencyId>
1091 <Scheme datatype="string">$faidScheme</Scheme>
1092 <Value datatype="string">$faidValue</Value>
1093 </UniqueAgencyId>
1094 <AgencyUserPrivilegeType>
1095 <Scheme datatype="string">http://testing.purposes.only</Scheme>
3bcdd8ae 1096 <Value datatype="string">$userpriv</Value>
5f517e0a
DW
1097 </AgencyUserPrivilegeType>
1098 <ValidToDate datatype="string">$good_until</ValidToDate>
1099 </UserPrivilege> $email $block_stanza
1100 </UserOptionalFields>
4cdc4f67
JS
1101 </LookupUserResponse>
1102</NCIPMessage>
1103
1104LOOKUPUSERRESPONSE
1105
5f517e0a
DW
1106 logit( $hd, ( caller(0) )[3] );
1107 staff_log( $taidValue, $faidValue,
1108 "LookupUser -> Patron Barcode : "
1109 . $id
1110 . " | Patron Id : "
1111 . $uidValue
1112 . " | User Name : "
1113 . $propername
1114 . " | User Priv : "
1115 . $userpriv );
4cdc4f67
JS
1116}
1117
4cdc4f67 1118sub fail {
5f517e0a
DW
1119 my $error_msg =
1120 shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
1121 print "Content-type: text/xml\n\n";
4cdc4f67 1122
5f517e0a 1123 print <<ITEMREQ;
4cdc4f67
JS
1124<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1125<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1126 <ItemRequestedResponse>
1127 <ResponseHeader>
1128 <FromAgencyId>
1129 <UniqueAgencyId>
1130 <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
1131 <Value></Value>
1132 </UniqueAgencyId>
1133 </FromAgencyId>
1134 <ToAgencyId>
1135 <UniqueAgencyId>
1136 <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
1137 <Value>$error_msg</Value>
1138 </UniqueAgencyId>
1139 </ToAgencyId>
1140 </ResponseHeader>
1141 </ItemRequestedResponse>
4cdc4f67
JS
1142</NCIPMessage>
1143
1144ITEMREQ
6e6bdfe9 1145
601be0bb
JG
1146 # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1147 staff_log( '', '',
5f517e0a
DW
1148 ( ( caller(0) )[3] . " -> " . $error_msg ) );
1149 die;
4cdc4f67
JS
1150}
1151
1152sub do_lookup_user_error_stanza {
1153
601be0bb 1154 # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
5f517e0a
DW
1155 my $error = shift;
1156 my $hd = <<LOOKUPPROB;
4cdc4f67
JS
1157Content-type: text/xml
1158
1159
1160<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1161<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1162 <LookupUserResponse>
1163 <ResponseHeader>
1164 <FromAgencyId>
1165 <UniqueAgencyId>
601be0bb
JG
1166 <Scheme></Scheme>
1167 <Value></Value>
5f517e0a
DW
1168 </UniqueAgencyId>
1169 </FromAgencyId>
1170 <ToAgencyId>
1171 <UniqueAgencyId>
601be0bb
JG
1172 <Scheme></Scheme>
1173 <Value></Value>
5f517e0a
DW
1174 </UniqueAgencyId>
1175 </ToAgencyId>
1176 </ResponseHeader>
1177 <Problem>
1178 <ProcessingError>
1179 <ProcessingErrorType>
1180 <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
1181 <Value>$error</Value>
1182 </ProcessingErrorType>
1183 <ProcessingErrorElement>
1184 <ElementName>AuthenticationInput</ElementName>
1185 </ProcessingErrorElement>
1186 </ProcessingError>
1187 </Problem>
1188 </LookupUserResponse>
4cdc4f67
JS
1189</NCIPMessage>
1190
1191LOOKUPPROB
1192
5f517e0a 1193 logit( $hd, ( caller(0) )[3] );
601be0bb
JG
1194 # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1195 staff_log( '', '', ( ( caller(0) )[3] . " -> " . $error ) );
5f517e0a 1196 die;
4cdc4f67
JS
1197}
1198
1199# Login to the OpenSRF system/Evergreen.
1200#
1201# Returns a hash with the authtoken, authtime, and expiration (time in
1202# seconds since 1/1/1970).
1203sub login {
1ac548f2
JS
1204
1205 # XXX: local opensrf core conf filename should be in config.
1206 # XXX: STAFF account with ncip service related permissions should be in config.
5f517e0a 1207 my $bootstrap = '/openils/conf/opensrf_core.xml';
f5e8d07e
JG
1208 my $uname = $conf->{auth}->{username};
1209 my $password = $conf->{auth}->{password};
5f517e0a
DW
1210
1211 # Bootstrap the client
1212 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
1213 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
1214 Fieldmapper->import( IDL => $idl );
1215
1216 # Initialize CStoreEditor:
1217 OpenILS::Utils::CStoreEditor->init;
1218
1219 my $seed = OpenSRF::AppSession->create('open-ils.auth')
1220 ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1221
1222 return undef unless $seed;
1223
1224 my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1225 'open-ils.auth.authenticate.complete',
1226 {
1227 username => $uname,
1228 password => md5_hex( $seed . md5_hex($password) ),
1229 type => 'staff'
1230 }
1231 )->gather(1);
1232
1233 return undef unless $response;
1234
1235 my %result;
1236 $result{'authtoken'} = $response->{payload}->{authtoken};
1237 $result{'authtime'} = $response->{payload}->{authtime};
1238 $result{'expiration'} = time() + $result{'authtime'}
1239 if ( defined( $result{'authtime'} ) );
1240 return %result;
4cdc4f67
JS
1241}
1242
1243# Check the time versus the session expiration time and login again if
1244# the session has expired, consequently resetting the session
1245# paramters. We want to run this before doing anything that requires
1246# us to have a current session in OpenSRF.
1247#
1248# Arguments
1249# none
1250#
1251# Returns
1252# Nothing
1253sub check_session_time {
5f517e0a
DW
1254 if ( time() > $session{'expiration'} ) {
1255 %session = login();
1256 if ( !%session ) {
1257 die("Failed to reinitialize the session after expiration.");
1258 }
1259 }
4cdc4f67
JS
1260}
1261
1262# Retrieve the logged in user.
1263#
1264sub get_session {
5f517e0a
DW
1265 my $response =
1266 OpenSRF::AppSession->create('open-ils.auth')
1267 ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1268 ->gather(1);
1269 return $response;
4cdc4f67
JS
1270}
1271
1272# Logout/destroy the OpenSRF session
1273#
1274# Argument is
1275# none
1276#
1277# Returns
1278# Does not return anything
1279sub logout {
5f517e0a
DW
1280 if ( time() < $session{'expiration'} ) {
1281 my $response =
1282 OpenSRF::AppSession->create('open-ils.auth')
1283 ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1284 ->gather(1);
1285 if ($response) {
1286
1287 # strong.silent.success
1288 exit(0);
1289 } else {
1290 fail("Logout unsuccessful. Good-bye, anyway.");
1291 }
1292 }
4cdc4f67
JS
1293}
1294
1295sub update_copy {
5f517e0a
DW
1296 check_session_time();
1297 my ( $copy, $status_id ) = @_;
1298 my $e = new_editor( authtoken => $session{authtoken} );
1299 return $e->event->{textcode} unless ( $e->checkauth );
1300 $e->xact_begin;
1301 $copy->status($status_id);
1302 return $e->event unless $e->update_asset_copy($copy);
1303 $e->commit;
1304 return 'SUCCESS';
4cdc4f67
JS
1305}
1306
1307# my paranoia re barcode on shipped items using visid for unique value
1308sub update_copy_shipped {
5f517e0a
DW
1309 check_session_time();
1310 my ( $copy, $status_id, $barcode ) = @_;
1311 my $e = new_editor( authtoken => $session{authtoken} );
1312 return $e->event->{textcode} unless ( $e->checkauth );
1313 $e->xact_begin;
1314 $copy->status($status_id);
1315 $copy->barcode($barcode);
1316 return $e->event unless $e->update_asset_copy($copy);
1317 $e->commit;
1318 return 'SUCCESS';
4cdc4f67
JS
1319}
1320
1321# Delete a copy
1322#
1323# Argument
1324# Fieldmapper asset.copy object
1325#
1326# Returns
1327# "SUCCESS" on success
1328# Event textcode if an error occurs
1329sub delete_copy {
5f517e0a
DW
1330 check_session_time();
1331 my ($copy) = @_;
1332
1333 my $e = new_editor( authtoken => $session{authtoken} );
1334 return $e->event->{textcode} unless ( $e->checkauth );
1335
1336 # Get the calnumber
1337 my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1338 return $e->event->{textcode} unless ($vol);
1339
1340 # Get the biblio.record_entry
1341 my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1342 return $e->event->{textcode} unless ($bre);
1343
1344 # Delete everything in a transaction and rollback if anything fails.
0b0c5299 1345 # TODO: I think there is a utility function which handles all this
5f517e0a
DW
1346 $e->xact_begin;
1347 my $r; # To hold results of editor calls
1348 $r = $e->delete_asset_copy($copy);
1349 unless ($r) {
1350 my $lval = $e->event->{textcode};
1351 $e->rollback;
1352 return $lval;
1353 }
1354 my $list =
1355 $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1356 unless (@$list) {
1357 $r = $e->delete_asset_call_number($vol);
1358 unless ($r) {
1359 my $lval = $e->event->{textcode};
1360 $e->rollback;
1361 return $lval;
1362 }
0b0c5299 1363 $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
5f517e0a 1364 unless (@$list) {
0b0c5299 1365 $r = $e->delete_biblio_record_entry($bre);
5f517e0a
DW
1366 unless ($r) {
1367 my $lval = $e->event->{textcode};
1368 $e->rollback;
1369 return $lval;
1370 }
1371 }
1372 }
1373 $e->commit;
1374 return 'SUCCESS';
4cdc4f67
JS
1375}
1376
1377# Get asset.copy from asset.copy.barcode.
1378# Arguments
1379# copy barcode
1380#
1381# Returns
1382# asset.copy fieldmaper object
1383# or hash on error
1384sub copy_from_barcode {
5f517e0a
DW
1385 check_session_time();
1386 my ($barcode) = @_;
1387 my $response =
1388 OpenSRF::AppSession->create('open-ils.search')
1389 ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1390 ->gather(1);
1391 return $response;
4cdc4f67
JS
1392}
1393
1394sub locid_from_barcode {
5f517e0a
DW
1395 my ($barcode) = @_;
1396 my $response =
1397 OpenSRF::AppSession->create('open-ils.search')
1398 ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1399 ->gather(1);
1400 return $response->{ids}[0];
4cdc4f67
JS
1401}
1402
3602ecf5
JG
1403sub bre_id_from_barcode {
1404 check_session_time();
1405 my ($barcode) = @_;
1406 my $response =
1407 OpenSRF::AppSession->create('open-ils.search')
1408 ->request( 'open-ils.search.bib_id.by_barcode', $barcode )
1409 ->gather(1);
1410 return $response;
1411}
1412
1413sub holds_for_bre {
1414 check_session_time();
1415 my ($bre_id) = @_;
1416 my $response =
1417 OpenSRF::AppSession->create('open-ils.circ')
1418 ->request( 'open-ils.circ.holds.retrieve_all_from_title', $session{authtoken}, $bre_id )
1419 ->gather(1);
1420 return $response;
1421
1422}
1423
4cdc4f67
JS
1424# Convert a MARC::Record to XML for Evergreen
1425#
6e6bdfe9 1426# Copied from Dyrcona's issa framework which copied
1ac548f2 1427# it from MVLC's Safari Load program which copied it
4cdc4f67
JS
1428# from some code in the Open-ILS example import scripts.
1429#
1430# Argument
1431# A MARC::Record object
1432#
1433# Returns
1434# String with XML for the MARC::Record as Evergreen likes it
1435sub convert2marcxml {
5f517e0a
DW
1436 my $input = shift;
1437 ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1438 $xml =~ s/^<\?xml.+\?\s*>//go;
1439 $xml =~ s/>\s+</></go;
1440 $xml =~ s/\p{Cc}//go;
0b0c5299 1441 $xml = $U->entityize($xml);
5f517e0a
DW
1442 $xml =~ s/[\x00-\x1f]//go;
1443 return $xml;
4cdc4f67
JS
1444}
1445
1446# Create a copy and marc record
1447#
1448# Arguments
1449# title
1450# call number
1451# copy barcode
1452#
1453# Returns
1454# bib id on succes
1455# event textcode on failure
1456sub create_copy {
5f517e0a
DW
1457 check_session_time();
1458 my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
4cdc4f67 1459
5f517e0a
DW
1460 my $e = new_editor( authtoken => $session{authtoken} );
1461 return $e->event->{textcode} unless ( $e->checkauth );
1ac548f2 1462
5f517e0a
DW
1463 my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1464 if ( ref($r) eq 'HASH' ) {
1465 return $r->{textcode} . ' ' . $r->{ilsperm};
1466 }
4cdc4f67 1467
5f517e0a
DW
1468 # Check if the barcode exists in asset.copy and bail if it does.
1469 my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1470 if (@$list) {
6e6bdfe9 1471# in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
5f517e0a
DW
1472 $e->finish;
1473 fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1474 die;
1475 }
1476
1477 # Create MARC record
1478 my $record = MARC::Record->new();
1479 $record->encoding('UTF-8');
1480 $record->leader('00881nam a2200193 4500');
1481 my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1482 my @fields = ();
1483 push( @fields, MARC::Field->new( '005', $datespec ) );
1484 push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1485 push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1486 $record->append_fields(@fields);
1487
1488 # Convert the record to XML
1489 my $xml = convert2marcxml($record);
1490
1491 my $bre =
1492 OpenSRF::AppSession->create('open-ils.cat')
1493 ->request( 'open-ils.cat.biblio.record.xml.import',
1494 $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1495 return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1496
1497 # Create volume record
1498 my $vol =
1499 OpenSRF::AppSession->create('open-ils.cat')
ba01d5da 1500 ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, $conf->{volume}->{owning_lib} )
0b0c5299 1501 ->gather(1);
5f517e0a
DW
1502 return $vol->{textcode} if ( $vol->{textcode} );
1503
1504 # Retrieve the user
1505 my $user = get_session;
1506
1507 # Create copy record
1508 my $copy = Fieldmapper::asset::copy->new();
0b0c5299
DW
1509 # XXX CUSTOMIZATION NEEDED XXX
1510 # You will need to either create a circ mod for every expected medium type,
1511 # OR you should create a single circ mod for all requests from the external
1512 # system.
1513 # Adjust these lines as needed.
1514 # $copy->circ_modifier(qq($medium_type)); # XXX CUSTOMIZATION NEEDED XXX
1515 # OR
ba01d5da 1516 $copy->circ_modifier($conf->{copy}->{circ_modifier});
5f517e0a
DW
1517 $copy->barcode($barcode);
1518 $copy->call_number( $vol->{acn_id} );
ba01d5da 1519 $copy->circ_lib($conf->{copy}->{circ_lib});
5f517e0a
DW
1520 $copy->circulate('t');
1521 $copy->holdable('t');
1522 $copy->opac_visible('t');
1523 $copy->deleted('f');
1524 $copy->fine_level(2);
1525 $copy->loan_duration(2);
ba01d5da 1526 $copy->location($conf->{copy}->{location});
5f517e0a
DW
1527 $copy->status($copy_status_id);
1528 $copy->editor('1');
1529 $copy->creator('1');
1530
5f517e0a
DW
1531 $e->xact_begin;
1532 $copy = $e->create_asset_copy($copy);
1533
5f517e0a
DW
1534 $e->commit;
1535 return $e->event->{textcode} unless ($r);
1536 return 'SUCCESS';
4cdc4f67
JS
1537}
1538
1539# Checkout a copy to a patron
1540#
1541# Arguments
1542# copy barcode
1543# patron barcode
1544#
1545# Returns
1546# textcode of the OSRF response.
1ac548f2 1547sub checkout {
5f517e0a
DW
1548 check_session_time();
1549 my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1550
1551 # Check for copy:
1552 my $copy = copy_from_barcode($copy_barcode);
1553 unless ( defined($copy) && blessed($copy) ) {
1554 return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1555 }
1556
1557 # Check for user
b9103e62
JG
1558 my $uid;
1559 if ($patron_id_type eq 'barcode') {
1560 $uid = user_id_from_barcode($patron_barcode);
1561 } else {
1562 $uid = $patron_barcode;
1563 }
5f517e0a
DW
1564 return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1565
1566 my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1567 'open-ils.circ.checkout.full.override',
1568 $session{authtoken},
1569 {
1570 copy_barcode => $copy_barcode,
1571 patron_id => $uid,
1572 due_date => $due_date
1573 }
1574 )->gather(1);
1575 return $response->{textcode};
4cdc4f67
JS
1576}
1577
1ac548f2 1578sub renewal {
5f517e0a
DW
1579 check_session_time();
1580 my ( $copy_barcode, $due_date ) = @_;
1581
1582 # Check for copy:
1583 my $copy = copy_from_barcode($copy_barcode);
1584 unless ( defined($copy) && blessed($copy) ) {
1585 return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1586 }
1587
1588 my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1589 'open-ils.circ.renew.override',
1590 $session{authtoken},
1591 {
1592 copy_barcode => $copy_barcode,
1593 due_date => $due_date
1594 }
1595 )->gather(1);
1596 return $response->{textcode};
4cdc4f67
JS
1597}
1598
1ac548f2 1599# Check a copy in
4cdc4f67
JS
1600#
1601# Arguments
1602# copy barcode
4cdc4f67
JS
1603#
1604# Returns
1605# "SUCCESS" on success
1606# textcode of a failed OSRF request
0b0c5299 1607# 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
6e6bdfe9 1608
1ac548f2 1609sub checkin {
5f517e0a 1610 check_session_time();
d077d8de
DW
1611 my ($barcode, $noop) = @_;
1612 $noop ||= 0;
5f517e0a
DW
1613
1614 my $copy = copy_from_barcode($barcode);
1615 return $copy->{textcode} unless ( blessed $copy);
1616
1617 return ("COPY_NOT_CHECKED_OUT $barcode")
1618 unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1619
1620 my $e = new_editor( authtoken => $session{authtoken} );
1621 return $e->event->{textcode} unless ( $e->checkauth );
1622
1623 my $circ = $e->search_action_circulation(
1624 [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1625 my $r =
1626 OpenSRF::AppSession->create('open-ils.circ')
1627 ->request( 'open-ils.circ.checkin.override',
d077d8de 1628 $session{authtoken}, { force => 1, copy_id => $copy->id, noop => $noop } )->gather(1);
5f517e0a
DW
1629 return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1630 return $r->{textcode};
4cdc4f67
JS
1631}
1632
272651d1
JG
1633# Check in an copy as part of accept_item
1634# Intent is for the copy to be captured for
1635# a hold -- the only hold that should be
1636# present on the copy
1637
1638sub checkin_accept {
1639 check_session_time();
1640 my $copy_id = shift;
1641 my $circ_lib = shift;
1642
1643 my $r = OpenSRF::AppSession->create('open-ils.circ')->request(
1644 'open-ils.circ.checkin.override',
1645 $session{authtoken}, { force => 1, copy_id => $copy_id, circ_lib => $circ_lib }
1646 )->gather(1);
1647
1648 return $r->{textcode};
1649}
1650
4cdc4f67
JS
1651# Get actor.usr.id from barcode.
1652# Arguments
1653# patron barcode
1654#
1655# Returns
1656# actor.usr.id
1657# or hash on error
1658sub user_id_from_barcode {
5f517e0a
DW
1659 check_session_time();
1660 my ($barcode) = @_;
4cdc4f67 1661
5f517e0a 1662 my $response;
4cdc4f67 1663
5f517e0a
DW
1664 my $e = new_editor( authtoken => $session{authtoken} );
1665 return $response unless ( $e->checkauth );
4cdc4f67 1666
5f517e0a
DW
1667 my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1668 return $e->event unless ($card);
4cdc4f67 1669
5f517e0a 1670 $response = $card->[0]->usr if (@$card);
4cdc4f67 1671
5f517e0a 1672 $e->finish;
4cdc4f67 1673
5f517e0a 1674 return $response;
4cdc4f67
JS
1675}
1676
6e6bdfe9 1677# Place a simple hold for a patron.
4cdc4f67
JS
1678#
1679# Arguments
1680# Target object appropriate for type of hold
1681# Patron for whom the hold is place
1682#
1683# Returns
1684# "SUCCESS" on success
1685# textcode of a failed OSRF request
1686# "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1687# (Currently only support 'T' and 'C')
1688
1ac548f2 1689# simple hold should be removed and full holds sub should be used instead - pragmatic solution only
5082b884 1690
4cdc4f67 1691sub place_simple_hold {
5f517e0a 1692 check_session_time();
1ac548f2 1693
5f517e0a 1694 #my ($type, $target, $patron, $pickup_ou) = @_;
7e2d6432 1695 my ( $target, $patron_id ) = @_;
1ac548f2 1696
ba01d5da 1697 require $conf->{path}->{oils_header};
5f517e0a 1698 use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1ac548f2 1699
ba01d5da 1700 osrf_connect( $conf->{path}->{opensrf_core} );
f5e8d07e 1701 oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
7e2d6432
DW
1702 my $ahr = Fieldmapper::action::hold_request->new();
1703 $ahr->hold_type('C');
1704 # The targeter doesn't like our special statuses, and changing the status after the targeter finishes is difficult because it runs asynchronously. Our workaround is to create the hold frozen, unfreeze it, then run the targeter manually.
1705 $ahr->target($target);
1706 $ahr->usr($patron_id);
ba01d5da
JG
1707 $ahr->requestor($conf->{hold}->{requestor});
1708 # NOTE: When User Agency, we don't know the pickup location until ItemShipped time
1709 # TODO: When Item Agency and using holds, set this to requested copy's circ lib?
1710 $ahr->pickup_lib($conf->{hold}->{init_pickup_lib});
1711 $ahr->phone_notify(''); # TODO: set this based on usr prefs
1712 $ahr->email_notify(1); # TODO: set this based on usr prefs
7e2d6432
DW
1713 $ahr->frozen('t');
1714 my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1715 my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1716 $ahr = $e->retrieve_action_hold_request($resp); # refresh from db
1717 $ahr->frozen('f');
1718 $e->update_action_hold_request($ahr);
1719 $e->commit;
1720 $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
5f517e0a
DW
1721
1722 #oils_event_die($resp);
1723 my $errors = "";
1724 if ( ref($resp) eq 'ARRAY' ) {
1725 ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1726 return $errors;
1727 } elsif ( ref($resp) ne 'HASH' ) {
1728 return "Hold placed! hold_id = " . $resp . "\n";
1729 }
4cdc4f67
JS
1730}
1731
b5a02cf6 1732sub find_hold_on_copy {
3602ecf5
JG
1733 check_session_time();
1734
b5a02cf6 1735 my ( $copy_barcode ) = @_;
3602ecf5
JG
1736
1737 # start with barcode of item, find bib ID
1738 my $rec = bre_id_from_barcode($copy_barcode);
1739
c8f50ddf
JG
1740 return undef unless $rec;
1741
3602ecf5
JG
1742 # call for holds on that bib
1743 my $holds = holds_for_bre($rec);
1744
1745 # There should only be a single copy hold
1746 my $hold_id = @{$holds->{copy_holds}}[0];
1747
c8f50ddf
JG
1748 return undef unless $hold_id;
1749
3602ecf5
JG
1750 my $hold_details =
1751 OpenSRF::AppSession->create('open-ils.circ')
1752 ->request( 'open-ils.circ.hold.details.retrieve', $session{authtoken}, $hold_id )
1753 ->gather(1);
1754
1755 my $hold = $hold_details->{hold};
1756
c8f50ddf
JG
1757 return undef unless blessed($hold);
1758
b5a02cf6
JG
1759 return $hold;
1760}
1761
1762sub update_hold_pickup {
1763 check_session_time();
1764
1765 my ( $copy_barcode, $pickup_lib ) = @_;
1766
1767 my $hold = find_hold_on_copy($copy_barcode);
1768
7a3e1d58
JG
1769 # return if hold was not found
1770 return undef unless defined($hold) && blessed($hold);
1771
3602ecf5
JG
1772 $hold->pickup_lib($pickup_lib);
1773
b5a02cf6 1774 # update the copy hold with the new pickup lib information
3602ecf5
JG
1775 my $result =
1776 OpenSRF::AppSession->create('open-ils.circ')
1777 ->request( 'open-ils.circ.hold.update', $session{authtoken}, $hold )
1778 ->gather(1);
1779
1780 return $result;
1781}
1782
b874ff79
DW
1783sub cancel_hold {
1784 check_session_time();
1785
1786 my ( $copy_barcode ) = @_;
1787
1788 my $hold = find_hold_on_copy($copy_barcode);
1789
1790 # return if hold was not found
1791 return undef unless defined($hold) && blessed($hold);
1792
1793 $hold->cancel_time('now()');
1794 $hold->cancel_cause(5); # 5 = 'Staff forced' (perhaps it should be 'Patron via SIP'?) or OPAC? or add NCIP to the cause table?
1795 $hold->cancel_note('NCIP cancellation request');
1796
1797 # update the copy hold with the new pickup lib information
1798 my $result =
1799 OpenSRF::AppSession->create('open-ils.circ')
1800 ->request( 'open-ils.circ.hold.update', $session{authtoken}, $hold )
1801 ->gather(1);
1802
1803 return $result;
1804}
1805
4cdc4f67
JS
1806# Flesh user information
1807# Arguments
1808# actor.usr.id
1809#
1810# Returns
1811# fieldmapped, fleshed user or
1812# event hash on error
1813sub flesh_user {
5f517e0a
DW
1814 check_session_time();
1815 my ($id) = @_;
1816 my $response =
1817 OpenSRF::AppSession->create('open-ils.actor')
1818 ->request( 'open-ils.actor.user.fleshed.retrieve',
1819 $session{'authtoken'}, $id,
1820 [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1821 ->gather(1);
1822 return $response;
4cdc4f67 1823}
8b41455d
JG
1824
1825sub _naive_encode_xml {
1826 my $val = shift;
1827
1828 $val =~ s/&/&amp;/g;
1829 $val =~ s/</&lt;/g;
1830 $val =~ s/>/&gt;/g;
1831
1832 return $val;
1833}