Fix patron blocking in LookupUser
[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
bb1d552c 510 # we are the user agency
5f517e0a
DW
511 $barcode .= $faidValue;
512 my $copy = copy_from_barcode($barcode);
513 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
514 my $r = delete_copy($copy);
515 } else {
bb1d552c 516 # we are the item agency
17682936
JG
517 unless ( $conf->{behavior}->{no_item_agency_holds} =~ m/^y/i ) {
518 # remove hold!
519 my $r = cancel_hold($barcode);
520 # TODO: check for any errors or unexpected return values in $r
521 my $copy = copy_from_barcode($barcode);
522 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
523 $r = update_copy( $copy, 7 ); # set to reshelving (for wiggle room)
524 # TODO: check for any errors or unexpected return values in $r
525 #
526 # XXX other options here could be:
527 # - Set to 'available' (it is probably still on the shelf, though it might be in the process of being retrieved)
528 # - 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
529 #
530 # 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.
531 }
5f517e0a
DW
532 }
533
534 my $hd = <<ITEMREQUESTCANCELLED;
4cdc4f67
JS
535Content-type: text/xml
536
537
538<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
539<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
540 <ItemRequestCancelledResponse>
541 <ResponseHeader>
542 <FromAgencyId>
543 <UniqueAgencyId>
544 <Scheme>$faidScheme</Scheme>
545 <Value>$faidValue</Value>
546 </UniqueAgencyId>
547 </FromAgencyId>
548 <ToAgencyId>
549 <UniqueAgencyId>
550 <Scheme>$taidScheme</Scheme>
551 <Value>$taidValue</Value>
552 </UniqueAgencyId>
553 </ToAgencyId>
554 </ResponseHeader>
555 <UniqueItemId>
556 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
557 </UniqueItemId>
558 </ItemRequestCancelledResponse>
4cdc4f67
JS
559</NCIPMessage>
560
561ITEMREQUESTCANCELLED
562
5f517e0a
DW
563 logit( $hd, ( caller(0) )[3] );
564 staff_log( $taidValue, $faidValue,
565 "ItemRequestCancelled -> Barcode : " . $barcode );
4cdc4f67
JS
566}
567
568sub item_checked_in {
5f517e0a
DW
569 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
570 my $faidScheme = HTML::Entities::encode($faidSchemeX);
571 my $faidValue = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
572 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
573 my $taidScheme = HTML::Entities::encode($taidSchemeX);
574 my $taidValue = $doc->find('/NCIPMessage/ItemCheckedIn/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
575
0b0c5299
DW
576 my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedIn/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
577 my $r = checkin($visid);
578 my $copy = copy_from_barcode($visid);
579 fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
ba01d5da 580 my $r2 = update_copy( $copy, $conf->{status}->{transit_return} ); # "INN-Reach Transit Return" status
5f517e0a
DW
581
582 my $hd = <<ITEMCHECKEDIN;
4cdc4f67
JS
583Content-type: text/xml
584
585
586<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
587<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
588 <ItemCheckedInResponse>
589 <ResponseHeader>
590 <FromAgencyId>
591 <UniqueAgencyId>
592 <Scheme>$faidScheme</Scheme>
593 <Value>$faidValue</Value>
594 </UniqueAgencyId>
595 </FromAgencyId>
596 <ToAgencyId>
597 <UniqueAgencyId>
598 <Scheme>$taidScheme</Scheme>
599 <Value>$taidValue</Value>
600 </UniqueAgencyId>
601 </ToAgencyId>
602 </ResponseHeader>
603 <UniqueItemId>
0b0c5299 604 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
5f517e0a
DW
605 </UniqueItemId>
606 </ItemCheckedInResponse>
4cdc4f67
JS
607</NCIPMessage>
608
609ITEMCHECKEDIN
610
5f517e0a 611 logit( $hd, ( caller(0) )[3] );
0b0c5299 612 staff_log( $taidValue, $faidValue, "ItemCheckedIn -> Visible ID : " . $visid );
4cdc4f67
JS
613}
614
615sub item_checked_out {
5f517e0a
DW
616 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
617 my $faidScheme = HTML::Entities::encode($faidSchemeX);
618 my $faidValue = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
619 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
620 my $taidScheme = HTML::Entities::encode($taidSchemeX);
621 my $taidValue = $doc->find('/NCIPMessage/ItemCheckedOut/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
622
0b0c5299 623 my $patron_barcode = $doc->findvalue('/NCIPMessage/ItemCheckedOut/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
5f517e0a 624 my $due_date = $doc->findvalue('/NCIPMessage/ItemCheckedOut/DateDue');
0b0c5299 625 my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedOut/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
5f517e0a
DW
626
627 my $copy = copy_from_barcode($visid);
628 fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
0b0c5299
DW
629 my $r = update_copy( $copy, 0 ); # seemed like copy had to be available before it could be checked out, so ...
630 my $r1 = checkin($visid) if ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT ); # double posted itemcheckedout messages cause error ... trying to simplify
631 my $r2 = checkout( $visid, $patron_barcode, $due_date );
5f517e0a
DW
632
633 my $hd = <<ITEMCHECKEDOUT;
4cdc4f67
JS
634Content-type: text/xml
635
636
637<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
638<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
639 <ItemCheckedOutResponse>
640 <ResponseHeader>
641 <FromAgencyId>
642 <UniqueAgencyId>
643 <Scheme>$faidScheme</Scheme>
644 <Value>$faidValue</Value>
645 </UniqueAgencyId>
646 </FromAgencyId>
647 <ToAgencyId>
648 <UniqueAgencyId>
649 <Scheme>$taidScheme</Scheme>
650 <Value>$taidValue</Value>
651 </UniqueAgencyId>
652 </ToAgencyId>
653 </ResponseHeader>
654 <UniqueItemId>
655 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
656 </UniqueItemId>
657 </ItemCheckedOutResponse>
4cdc4f67
JS
658</NCIPMessage>
659
660ITEMCHECKEDOUT
661
5f517e0a
DW
662 logit( $hd, ( caller(0) )[3] );
663 staff_log( $taidValue, $faidValue,
0b0c5299 664 "ItemCheckedOut -> Visible Id : " . $visid . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
4cdc4f67
JS
665}
666
667sub check_out_item {
5f517e0a
DW
668 my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
669 my $faidScheme = HTML::Entities::encode($faidSchemeX);
670 my $faidValue = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
671 my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
672 my $taidScheme = HTML::Entities::encode($taidSchemeX);
673 my $taidValue = $doc->find('/NCIPMessage/CheckOutItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
674
675 my $mdate = $doc->findvalue('/NCIPMessage/CheckOutItem/MandatedAction/DateEventOccurred');
119c2c2f
JG
676 # TODO: look up individual accounts for agencies based on barcode prefix + agency identifier
677 my $patron_barcode = $conf->{checkout}->{institutional_patron}; # patron id if patron_id_as_identifier = yes
5f517e0a 678
04643d4b 679 # For CheckOutItem and INN-REACH, this value will correspond with our local barcode
5f517e0a 680 my $barcode = $doc->findvalue('/NCIPMessage/CheckOutItem/UniqueItemId/ItemIdentifierValue');
0b0c5299
DW
681
682 # TODO: watch for possible real ids here?
5f517e0a
DW
683 my $due_date = $doc->findvalue('/NCIPMessage/CheckOutItem/DateDue');
684
685 my $copy = copy_from_barcode($barcode);
686 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
687
0b0c5299
DW
688 my $r2 = checkout( $barcode, $patron_barcode, $due_date );
689
690 # TODO: check for checkout exception (like OPEN_CIRCULATION_EXISTS)
5f517e0a
DW
691
692 my $hd = <<CHECKOUTITEM;
4cdc4f67
JS
693Content-type: text/xml
694
695
696<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
697<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
698 <CheckOutItemResponse>
699 <ResponseHeader>
700 <FromAgencyId>
701 <UniqueAgencyId>
702 <Scheme>$faidScheme</Scheme>
703 <Value>$faidValue</Value>
704 </UniqueAgencyId>
705 </FromAgencyId>
706 <ToAgencyId>
707 <UniqueAgencyId>
708 <Scheme>$taidScheme</Scheme>
709 <Value>$taidValue</Value>
710 </UniqueAgencyId>
711 </ToAgencyId>
712 </ResponseHeader>
713 <UniqueItemId>
714 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
715 </UniqueItemId>
716 </CheckOutItemResponse>
4cdc4f67
JS
717</NCIPMessage>
718
719CHECKOUTITEM
720
5f517e0a
DW
721 logit( $hd, ( caller(0) )[3] );
722 staff_log( $taidValue, $faidValue,
0b0c5299 723 "CheckOutItem -> Barcode : " . $barcode . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
4cdc4f67
JS
724}
725
726sub check_in_item {
5f517e0a
DW
727 my $faidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
728 my $faidScheme = HTML::Entities::encode($faidSchemeX);
729 my $faidValue = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
730 my $taidSchemeX = $doc->findvalue('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
731 my $taidScheme = HTML::Entities::encode($taidSchemeX);
732 my $taidValue = $doc->find('/NCIPMessage/CheckInItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
733
04643d4b 734 # For CheckInItem and INN-REACH, this value will correspond with our local barcode
5f517e0a 735 my $barcode = $doc->findvalue('/NCIPMessage/CheckInItem/UniqueItemId/ItemIdentifierValue');
d077d8de 736 my $r = checkin($barcode, 1);
2606eada
DW
737 fail($r) if $r =~ /^COPY_NOT_CHECKED_OUT/;
738 # 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
739 ##my $copy = copy_from_barcode($barcode);
740 ##fail($copy->{textcode}." $barcode") unless (blessed $copy);
741 ## my $r2 = update_copy($copy,0); # Available now
5f517e0a
DW
742
743 my $hd = <<CHECKINITEM;
4cdc4f67
JS
744Content-type: text/xml
745
746
747<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
748<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
749 <CheckInItemResponse>
750 <ResponseHeader>
751 <FromAgencyId>
752 <UniqueAgencyId>
753 <Scheme>$faidScheme</Scheme>
754 <Value>$faidValue</Value>
755 </UniqueAgencyId>
756 </FromAgencyId>
757 <ToAgencyId>
758 <UniqueAgencyId>
759 <Scheme>$taidScheme</Scheme>
760 <Value>$taidValue</Value>
761 </UniqueAgencyId>
762 </ToAgencyId>
763 </ResponseHeader>
764 <UniqueItemId>
765 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
766 </UniqueItemId>
767 </CheckInItemResponse>
4cdc4f67
JS
768</NCIPMessage>
769
770CHECKINITEM
771
5f517e0a
DW
772 logit( $hd, ( caller(0) )[3] );
773 staff_log( $taidValue, $faidValue, "CheckInItem -> Barcode : " . $barcode );
4cdc4f67
JS
774}
775
776sub item_shipped {
5f517e0a
DW
777 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
778 my $faidScheme = HTML::Entities::encode($faidSchemeX);
779 my $faidValue = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
780 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
781 my $taidScheme = HTML::Entities::encode($taidSchemeX);
782 my $taidValue = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
783
3602ecf5
JG
784 my $address = $doc->findvalue('/NCIPMessage/ItemShipped/ShippingInformation/PhysicalAddress/UnstructuredAddress/UnstructuredAddressData');
785
5f517e0a
DW
786 my $visid = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
787 my $barcode = $doc->findvalue('/NCIPMessage/ItemShipped/UniqueItemId/ItemIdentifierValue') . $faidValue;
788 my $title = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/BibliographicDescription/Title');
789 my $callnumber = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/CallNumber');
790
791 my $copy = copy_from_barcode($barcode);
3602ecf5 792
0a9f148c 793 fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
b874cb1d 794
3602ecf5
JG
795 my $pickup_lib;
796
797 if ($address) {
798 my $pickup_lib_map = load_map_file( $conf->{path}->{pickup_lib_map} );
799
800 if ($pickup_lib_map) {
801 $pickup_lib = lookup_pickup_lib($address, $pickup_lib_map);
802 }
803 }
804
805 if ($pickup_lib) {
806 update_hold_pickup($barcode, $pickup_lib);
807 }
808
ba01d5da 809 my $r = update_copy_shipped( $copy, $conf->{status}->{transit}, $visid ); # put copy into INN-Reach Transit status & modify barcode = Visid != tempIIIiNumber
9c7410f8
DW
810 if ($r ne 'SUCCESS') {
811 fail( $r->{textcode} . ", Barcode: $barcode, Visible ID: $visid" )
812 }
5f517e0a
DW
813
814 my $hd = <<ITEMSHIPPED;
4cdc4f67
JS
815Content-type: text/xml
816
817
818<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
819<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
820 <ItemShippedResponse>
821 <ResponseHeader>
822 <FromAgencyId>
823 <UniqueAgencyId>
824 <Scheme>$faidScheme</Scheme>
825 <Value>$faidValue</Value>
826 </UniqueAgencyId>
827 </FromAgencyId>
828 <ToAgencyId>
829 <UniqueAgencyId>
830 <Scheme>$taidScheme</Scheme>
831 <Value>$taidValue</Value>
832 </UniqueAgencyId>
833 </ToAgencyId>
834 </ResponseHeader>
835 <UniqueItemId>
836 <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
837 </UniqueItemId>
838 </ItemShippedResponse>
4cdc4f67
JS
839</NCIPMessage>
840
841ITEMSHIPPED
842
5f517e0a
DW
843 logit( $hd, ( caller(0) )[3] );
844 staff_log( $taidValue, $faidValue,
0b0c5299 845 "ItemShipped -> Visible Id : " . $visid . " | Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber );
4cdc4f67
JS
846}
847
848sub item_request {
5f517e0a
DW
849 my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
850 my $faidScheme = HTML::Entities::encode($faidSchemeX);
851 my $faidValue = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
852
853 my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
854 my $taidScheme = HTML::Entities::encode($taidSchemeX);
855 my $taidValue = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
856 my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/UniqueAgencyId/Value');
857
0b0c5299
DW
858 # TODO: should we use the VisibleID for item agency variation of this method call
859
860 my $pid = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueUserId/UserIdentifierValue');
5f517e0a
DW
861 my $barcode = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/ItemIdentifierValue');
862 my $author = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Author');
863 my $title = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Title');
864 my $callnumber = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/ItemDescription/CallNumber');
865 my $medium_type = $doc->find('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/MediumType/Value');
866
867 my $r = "default error checking response";
868
a30f6f9e 869 if ( $barcode =~ /^i/ ) { # XXX EG is User Agency # create copy only if barcode is an iNUMBER
ba01d5da 870 my $copy_status_id = $conf->{status}->{loan_requested}; # INN-Reach Loan Requested - local configured status
5f517e0a 871 $barcode .= $faidValue;
a30f6f9e
DW
872 # 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
873 $r = create_copy( $title, $callnumber, $barcode, 0, $medium_type );
874 my $copy = copy_from_barcode($barcode);
875 my $r2 = place_simple_hold( $copy->id, $pid );
876 my $r3 = update_copy( $copy, $copy_status_id );
877 } else { # XXX EG is Item Agency
15d084ee
JG
878 unless ( $conf->{behavior}->{no_item_agency_holds} =~ m/^y/i ) {
879 # place hold for user UniqueUserId/UniqueAgencyId/Value = institution account
880 my $copy = copy_from_barcode($barcode);
881 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
882 $r = place_simple_hold( $copy->id, $pid2 );
883 my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
884 }
5f517e0a
DW
885 }
886
ef5a5276 887 # Avoid generating invalid XML responses by encoding title/author/callnumber
20bfa6cb 888 # TODO: Move away from heredocs for generating XML
8b41455d
JG
889 $title = _naive_encode_xml($title);
890 $author = _naive_encode_xml($author);
891 $callnumber = _naive_encode_xml($callnumber);
20bfa6cb 892
5f517e0a 893 my $hd = <<ITEMREQ;
4cdc4f67
JS
894Content-type: text/xml
895
896
897<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
898<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
899 <ItemRequestedResponse>
900 <ResponseHeader>
901 <FromAgencyId>
902 <UniqueAgencyId>
903 <Scheme>$faidScheme</Scheme>
904 <Value>$faidValue</Value>
905 </UniqueAgencyId>
906 </FromAgencyId>
907 <ToAgencyId>
908 <UniqueAgencyId>
909 <Scheme>$taidScheme</Scheme>
910 <Value>$taidValue</Value>
911 </UniqueAgencyId>
912 </ToAgencyId>
913 </ResponseHeader>
914 <UniqueUserId>
915 <UniqueAgencyId>
916 <Scheme datatype="string">$taidScheme</Scheme>
917 <Value datatype="string">$taidValue</Value>
918 </UniqueAgencyId>
0b0c5299 919 <UserIdentifierValue datatype="string">$pid</UserIdentifierValue>
5f517e0a
DW
920 </UniqueUserId>
921 <UniqueItemId>
922 <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
923 </UniqueItemId>
924 <ItemOptionalFields>
925 <BibliographicDescription>
926 <Author datatype="string">$author</Author>
927 <Title datatype="string">$title</Title>
928 </BibliographicDescription>
929 <ItemDescription>
930 <CallNumber datatype="string">$callnumber</CallNumber>
931 </ItemDescription>
932 </ItemOptionalFields>
933 </ItemRequestedResponse>
4cdc4f67
JS
934</NCIPMessage>
935
936ITEMREQ
937
5f517e0a
DW
938 logit( $hd, ( caller(0) )[3] );
939 staff_log( $taidValue, $faidValue,
0b0c5299 940 "ItemRequested -> Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber . " | Patronid :" . $pid );
4cdc4f67
JS
941}
942
1ac548f2
JS
943sub lookupUser {
944
5f517e0a
DW
945 my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
946 $faidScheme = HTML::Entities::encode($faidScheme);
947 my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
948 my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
949 $taidScheme = HTML::Entities::encode($taidScheme);
950
951 my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
952 my $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
b9103e62
JG
953
954 my $uidValue;
955
956 if ($patron_id_type eq 'barcode') {
957 $uidValue = user_id_from_barcode($id);
958 } else {
959 $uidValue = $id;
960 }
5f517e0a
DW
961
962 if ( !defined($uidValue)
963 || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
964 {
965 do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
966 die;
967 }
968
3bcdd8ae
JG
969 my ( $propername, $email, $good_until, $userpriv, $block_stanza ) =
970 ( "name here", "", "good until", "", "" ); # defaults
5f517e0a
DW
971
972 my $patron = flesh_user($uidValue);
973
974 #if (blessed($patron)) {
975 my $patron_ok = 1;
976 my @penalties = @{ $patron->standing_penalties };
977
978 if ( $patron->deleted eq 't' ) {
979 do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
980 die;
981 } elsif ( $patron->barred eq 't' ) {
982 do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
983 die;
984 } elsif ( $patron->active eq 'f' ) {
985 do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
986 die;
987 }
988
989 elsif ( $#penalties > -1 ) {
990
236a8b72
JG
991 # Block only on standing penalties that have CIRC or HOLD in their block list
992 my $block_types = [qw/CIRC HOLD/];
993
994 my $penalty;
995 foreach $penalty (@penalties) {
996 if (defined($penalty->standing_penalty->block_list)) {
997 my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
998 foreach my $block (@block_list) {
999 foreach my $block_on (@$block_types) {
1000 if ($block eq $block_on) {
1001 $block_stanza .= "\n".$penalty->standing_penalty->name;
1002 $patron_ok = 0;
1003 }
1004 last unless ($patron_ok);
1005 }
1006 last unless ($patron_ok);
1007 }
1008 }
1009 }
1010 }
1011 unless ($patron_ok) {
5f517e0a
DW
1012 $block_stanza = qq(
1013 <BlockOrTrap>
1014 <UniqueAgencyId>
1015 <Scheme datatype="string">http://just.testing.now</Scheme>
1016 <Value datatype="string">$faidValue</Value>
1017 </UniqueAgencyId>
1018 <BlockOrTrapType>
1019 <Scheme datatype="string">http://just.testing.now</Scheme>
1020 <Value datatype="string">Block Hold</Value>
1021 </BlockOrTrapType>
1022 </BlockOrTrap>);
1023 }
1024
5809d230 1025 if ( defined( $patron->email ) && $conf->{behavior}->{omit_patron_email} !~ m/^y/i ) {
5f517e0a
DW
1026 $email = qq(
1027 <UserAddressInformation>
1028 <ElectronicAddress>
1029 <ElectronicAddressType>
1030 <Scheme datatype="string">http://testing.now</Scheme>
1031 <Value datatype="string">mailto</Value>
1032 </ElectronicAddressType>
1033 <ElectronicAddressData datatype="string">)
1034 . HTML::Entities::encode( $patron->email )
1035 . qq(</ElectronicAddressData>
1036 </ElectronicAddress>
1037 </UserAddressInformation>);
1038 }
1039
1040 $propername = $patron->first_given_name . " " . $patron->family_name;
1041 $good_until = $patron->expire_date || "unknown";
33a39c82 1042 $userpriv = $patron->profile->name;
5f517e0a 1043
3602ecf5 1044 my $userpriv_map = load_map_file( $conf->{path}->{userpriv_map} );
47866eef
JG
1045
1046 if ($userpriv_map) {
45d455be 1047 $userpriv = lookup_userpriv($userpriv, $userpriv_map);
47866eef
JG
1048 }
1049
5f517e0a
DW
1050 #} else {
1051 # do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
1052 # die;
1053 #}
0b0c5299 1054 my $uniqid = $patron->id;
b9103e62
JG
1055 my $visid;
1056 if ($patron_id_type eq 'barcode') {
1057 $visid = $patron->card->barcode;
1058 } else {
1059 $visid = $patron->id;
1060 }
5f517e0a 1061 my $hd = <<LOOKUPUSERRESPONSE;
4cdc4f67
JS
1062Content-type: text/xml
1063
1064
1065<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1066<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1067 <LookupUserResponse>
1068 <ResponseHeader>
1069 <FromAgencyId>
1070 <UniqueAgencyId>
1071 <Scheme>$taidScheme</Scheme>
1072 <Value>$taidValue</Value>
1073 </UniqueAgencyId>
1074 </FromAgencyId>
1075 <ToAgencyId>
1076 <UniqueAgencyId>
1077 <Scheme>$faidScheme</Scheme>
1078 <Value>$faidValue</Value>
1079 </UniqueAgencyId>
1080 </ToAgencyId>
1081 </ResponseHeader>
1082 <UniqueUserId>
1083 <UniqueAgencyId>
1084 <Scheme>$taidScheme</Scheme>
1085 <Value>$taidValue</Value>
1086 </UniqueAgencyId>
0b0c5299 1087 <UserIdentifierValue>$uniqid</UserIdentifierValue>
5f517e0a
DW
1088 </UniqueUserId>
1089 <UserOptionalFields>
1090 <VisibleUserId>
1091 <VisibleUserIdentifierType>
1092 <Scheme datatype="string">http://blah.com</Scheme>
1093 <Value datatype="string">Barcode</Value>
1094 </VisibleUserIdentifierType>
0b0c5299 1095 <VisibleUserIdentifier datatype="string">$visid</VisibleUserIdentifier>
5f517e0a
DW
1096 </VisibleUserId>
1097 <NameInformation>
1098 <PersonalNameInformation>
1099 <UnstructuredPersonalUserName datatype="string">$propername</UnstructuredPersonalUserName>
1100 </PersonalNameInformation>
1101 </NameInformation>
1102 <UserPrivilege>
1103 <UniqueAgencyId>
1104 <Scheme datatype="string">$faidScheme</Scheme>
1105 <Value datatype="string">$faidValue</Value>
1106 </UniqueAgencyId>
1107 <AgencyUserPrivilegeType>
1108 <Scheme datatype="string">http://testing.purposes.only</Scheme>
3bcdd8ae 1109 <Value datatype="string">$userpriv</Value>
5f517e0a
DW
1110 </AgencyUserPrivilegeType>
1111 <ValidToDate datatype="string">$good_until</ValidToDate>
1112 </UserPrivilege> $email $block_stanza
1113 </UserOptionalFields>
4cdc4f67
JS
1114 </LookupUserResponse>
1115</NCIPMessage>
1116
1117LOOKUPUSERRESPONSE
1118
5f517e0a
DW
1119 logit( $hd, ( caller(0) )[3] );
1120 staff_log( $taidValue, $faidValue,
1121 "LookupUser -> Patron Barcode : "
1122 . $id
1123 . " | Patron Id : "
1124 . $uidValue
1125 . " | User Name : "
1126 . $propername
1127 . " | User Priv : "
1128 . $userpriv );
4cdc4f67
JS
1129}
1130
4cdc4f67 1131sub fail {
5f517e0a
DW
1132 my $error_msg =
1133 shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
1134 print "Content-type: text/xml\n\n";
4cdc4f67 1135
5f517e0a 1136 print <<ITEMREQ;
4cdc4f67
JS
1137<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1138<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1139 <ItemRequestedResponse>
1140 <ResponseHeader>
1141 <FromAgencyId>
1142 <UniqueAgencyId>
1143 <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
1144 <Value></Value>
1145 </UniqueAgencyId>
1146 </FromAgencyId>
1147 <ToAgencyId>
1148 <UniqueAgencyId>
1149 <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
1150 <Value>$error_msg</Value>
1151 </UniqueAgencyId>
1152 </ToAgencyId>
1153 </ResponseHeader>
1154 </ItemRequestedResponse>
4cdc4f67
JS
1155</NCIPMessage>
1156
1157ITEMREQ
6e6bdfe9 1158
601be0bb
JG
1159 # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1160 staff_log( '', '',
5f517e0a
DW
1161 ( ( caller(0) )[3] . " -> " . $error_msg ) );
1162 die;
4cdc4f67
JS
1163}
1164
1165sub do_lookup_user_error_stanza {
1166
601be0bb 1167 # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
5f517e0a
DW
1168 my $error = shift;
1169 my $hd = <<LOOKUPPROB;
4cdc4f67
JS
1170Content-type: text/xml
1171
1172
1173<!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
1174<NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
5f517e0a
DW
1175 <LookupUserResponse>
1176 <ResponseHeader>
1177 <FromAgencyId>
1178 <UniqueAgencyId>
601be0bb
JG
1179 <Scheme></Scheme>
1180 <Value></Value>
5f517e0a
DW
1181 </UniqueAgencyId>
1182 </FromAgencyId>
1183 <ToAgencyId>
1184 <UniqueAgencyId>
601be0bb
JG
1185 <Scheme></Scheme>
1186 <Value></Value>
5f517e0a
DW
1187 </UniqueAgencyId>
1188 </ToAgencyId>
1189 </ResponseHeader>
1190 <Problem>
1191 <ProcessingError>
1192 <ProcessingErrorType>
1193 <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
1194 <Value>$error</Value>
1195 </ProcessingErrorType>
1196 <ProcessingErrorElement>
1197 <ElementName>AuthenticationInput</ElementName>
1198 </ProcessingErrorElement>
1199 </ProcessingError>
1200 </Problem>
1201 </LookupUserResponse>
4cdc4f67
JS
1202</NCIPMessage>
1203
1204LOOKUPPROB
1205
5f517e0a 1206 logit( $hd, ( caller(0) )[3] );
601be0bb
JG
1207 # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1208 staff_log( '', '', ( ( caller(0) )[3] . " -> " . $error ) );
5f517e0a 1209 die;
4cdc4f67
JS
1210}
1211
1212# Login to the OpenSRF system/Evergreen.
1213#
1214# Returns a hash with the authtoken, authtime, and expiration (time in
1215# seconds since 1/1/1970).
1216sub login {
1ac548f2
JS
1217
1218 # XXX: local opensrf core conf filename should be in config.
1219 # XXX: STAFF account with ncip service related permissions should be in config.
5f517e0a 1220 my $bootstrap = '/openils/conf/opensrf_core.xml';
f5e8d07e
JG
1221 my $uname = $conf->{auth}->{username};
1222 my $password = $conf->{auth}->{password};
5f517e0a
DW
1223
1224 # Bootstrap the client
1225 OpenSRF::System->bootstrap_client( config_file => $bootstrap );
1226 my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
1227 Fieldmapper->import( IDL => $idl );
1228
1229 # Initialize CStoreEditor:
1230 OpenILS::Utils::CStoreEditor->init;
1231
1232 my $seed = OpenSRF::AppSession->create('open-ils.auth')
1233 ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1234
1235 return undef unless $seed;
1236
1237 my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1238 'open-ils.auth.authenticate.complete',
1239 {
1240 username => $uname,
1241 password => md5_hex( $seed . md5_hex($password) ),
1242 type => 'staff'
1243 }
1244 )->gather(1);
1245
1246 return undef unless $response;
1247
1248 my %result;
1249 $result{'authtoken'} = $response->{payload}->{authtoken};
1250 $result{'authtime'} = $response->{payload}->{authtime};
1251 $result{'expiration'} = time() + $result{'authtime'}
1252 if ( defined( $result{'authtime'} ) );
1253 return %result;
4cdc4f67
JS
1254}
1255
1256# Check the time versus the session expiration time and login again if
1257# the session has expired, consequently resetting the session
1258# paramters. We want to run this before doing anything that requires
1259# us to have a current session in OpenSRF.
1260#
1261# Arguments
1262# none
1263#
1264# Returns
1265# Nothing
1266sub check_session_time {
5f517e0a
DW
1267 if ( time() > $session{'expiration'} ) {
1268 %session = login();
1269 if ( !%session ) {
1270 die("Failed to reinitialize the session after expiration.");
1271 }
1272 }
4cdc4f67
JS
1273}
1274
1275# Retrieve the logged in user.
1276#
1277sub get_session {
5f517e0a
DW
1278 my $response =
1279 OpenSRF::AppSession->create('open-ils.auth')
1280 ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1281 ->gather(1);
1282 return $response;
4cdc4f67
JS
1283}
1284
1285# Logout/destroy the OpenSRF session
1286#
1287# Argument is
1288# none
1289#
1290# Returns
1291# Does not return anything
1292sub logout {
5f517e0a
DW
1293 if ( time() < $session{'expiration'} ) {
1294 my $response =
1295 OpenSRF::AppSession->create('open-ils.auth')
1296 ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1297 ->gather(1);
1298 if ($response) {
1299
1300 # strong.silent.success
1301 exit(0);
1302 } else {
1303 fail("Logout unsuccessful. Good-bye, anyway.");
1304 }
1305 }
4cdc4f67
JS
1306}
1307
1308sub update_copy {
5f517e0a
DW
1309 check_session_time();
1310 my ( $copy, $status_id ) = @_;
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 return $e->event unless $e->update_asset_copy($copy);
1316 $e->commit;
1317 return 'SUCCESS';
4cdc4f67
JS
1318}
1319
1320# my paranoia re barcode on shipped items using visid for unique value
1321sub update_copy_shipped {
5f517e0a
DW
1322 check_session_time();
1323 my ( $copy, $status_id, $barcode ) = @_;
1324 my $e = new_editor( authtoken => $session{authtoken} );
9c7410f8 1325 return $e->event unless ( $e->checkauth );
5f517e0a
DW
1326 $e->xact_begin;
1327 $copy->status($status_id);
1328 $copy->barcode($barcode);
1329 return $e->event unless $e->update_asset_copy($copy);
1330 $e->commit;
1331 return 'SUCCESS';
4cdc4f67
JS
1332}
1333
1334# Delete a copy
1335#
1336# Argument
1337# Fieldmapper asset.copy object
1338#
1339# Returns
1340# "SUCCESS" on success
1341# Event textcode if an error occurs
1342sub delete_copy {
5f517e0a
DW
1343 check_session_time();
1344 my ($copy) = @_;
1345
1346 my $e = new_editor( authtoken => $session{authtoken} );
1347 return $e->event->{textcode} unless ( $e->checkauth );
1348
1349 # Get the calnumber
1350 my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1351 return $e->event->{textcode} unless ($vol);
1352
1353 # Get the biblio.record_entry
1354 my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1355 return $e->event->{textcode} unless ($bre);
1356
1357 # Delete everything in a transaction and rollback if anything fails.
0b0c5299 1358 # TODO: I think there is a utility function which handles all this
5f517e0a
DW
1359 $e->xact_begin;
1360 my $r; # To hold results of editor calls
1361 $r = $e->delete_asset_copy($copy);
1362 unless ($r) {
1363 my $lval = $e->event->{textcode};
1364 $e->rollback;
1365 return $lval;
1366 }
1367 my $list =
1368 $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1369 unless (@$list) {
1370 $r = $e->delete_asset_call_number($vol);
1371 unless ($r) {
1372 my $lval = $e->event->{textcode};
1373 $e->rollback;
1374 return $lval;
1375 }
0b0c5299 1376 $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
5f517e0a 1377 unless (@$list) {
0b0c5299 1378 $r = $e->delete_biblio_record_entry($bre);
5f517e0a
DW
1379 unless ($r) {
1380 my $lval = $e->event->{textcode};
1381 $e->rollback;
1382 return $lval;
1383 }
1384 }
1385 }
1386 $e->commit;
1387 return 'SUCCESS';
4cdc4f67
JS
1388}
1389
1390# Get asset.copy from asset.copy.barcode.
1391# Arguments
1392# copy barcode
1393#
1394# Returns
1395# asset.copy fieldmaper object
1396# or hash on error
1397sub copy_from_barcode {
5f517e0a
DW
1398 check_session_time();
1399 my ($barcode) = @_;
1400 my $response =
1401 OpenSRF::AppSession->create('open-ils.search')
1402 ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1403 ->gather(1);
1404 return $response;
4cdc4f67
JS
1405}
1406
1407sub locid_from_barcode {
5f517e0a
DW
1408 my ($barcode) = @_;
1409 my $response =
1410 OpenSRF::AppSession->create('open-ils.search')
1411 ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1412 ->gather(1);
1413 return $response->{ids}[0];
4cdc4f67
JS
1414}
1415
3602ecf5
JG
1416sub bre_id_from_barcode {
1417 check_session_time();
1418 my ($barcode) = @_;
1419 my $response =
1420 OpenSRF::AppSession->create('open-ils.search')
1421 ->request( 'open-ils.search.bib_id.by_barcode', $barcode )
1422 ->gather(1);
1423 return $response;
1424}
1425
1426sub holds_for_bre {
1427 check_session_time();
1428 my ($bre_id) = @_;
1429 my $response =
1430 OpenSRF::AppSession->create('open-ils.circ')
1431 ->request( 'open-ils.circ.holds.retrieve_all_from_title', $session{authtoken}, $bre_id )
1432 ->gather(1);
1433 return $response;
1434
1435}
1436
4cdc4f67
JS
1437# Convert a MARC::Record to XML for Evergreen
1438#
6e6bdfe9 1439# Copied from Dyrcona's issa framework which copied
1ac548f2 1440# it from MVLC's Safari Load program which copied it
4cdc4f67
JS
1441# from some code in the Open-ILS example import scripts.
1442#
1443# Argument
1444# A MARC::Record object
1445#
1446# Returns
1447# String with XML for the MARC::Record as Evergreen likes it
1448sub convert2marcxml {
5f517e0a
DW
1449 my $input = shift;
1450 ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1451 $xml =~ s/^<\?xml.+\?\s*>//go;
1452 $xml =~ s/>\s+</></go;
1453 $xml =~ s/\p{Cc}//go;
0b0c5299 1454 $xml = $U->entityize($xml);
5f517e0a
DW
1455 $xml =~ s/[\x00-\x1f]//go;
1456 return $xml;
4cdc4f67
JS
1457}
1458
1459# Create a copy and marc record
1460#
1461# Arguments
1462# title
1463# call number
1464# copy barcode
1465#
1466# Returns
1467# bib id on succes
1468# event textcode on failure
1469sub create_copy {
5f517e0a
DW
1470 check_session_time();
1471 my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
4cdc4f67 1472
5f517e0a
DW
1473 my $e = new_editor( authtoken => $session{authtoken} );
1474 return $e->event->{textcode} unless ( $e->checkauth );
1ac548f2 1475
5f517e0a
DW
1476 my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1477 if ( ref($r) eq 'HASH' ) {
1478 return $r->{textcode} . ' ' . $r->{ilsperm};
1479 }
4cdc4f67 1480
5f517e0a
DW
1481 # Check if the barcode exists in asset.copy and bail if it does.
1482 my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1483 if (@$list) {
6e6bdfe9 1484# in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
5f517e0a
DW
1485 $e->finish;
1486 fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1487 die;
1488 }
1489
1490 # Create MARC record
1491 my $record = MARC::Record->new();
1492 $record->encoding('UTF-8');
1493 $record->leader('00881nam a2200193 4500');
1494 my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1495 my @fields = ();
1496 push( @fields, MARC::Field->new( '005', $datespec ) );
1497 push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1498 push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1499 $record->append_fields(@fields);
1500
1501 # Convert the record to XML
1502 my $xml = convert2marcxml($record);
1503
1504 my $bre =
1505 OpenSRF::AppSession->create('open-ils.cat')
1506 ->request( 'open-ils.cat.biblio.record.xml.import',
1507 $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1508 return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1509
1510 # Create volume record
1511 my $vol =
1512 OpenSRF::AppSession->create('open-ils.cat')
ba01d5da 1513 ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, $conf->{volume}->{owning_lib} )
0b0c5299 1514 ->gather(1);
5f517e0a
DW
1515 return $vol->{textcode} if ( $vol->{textcode} );
1516
1517 # Retrieve the user
1518 my $user = get_session;
1519
1520 # Create copy record
1521 my $copy = Fieldmapper::asset::copy->new();
0b0c5299
DW
1522 # XXX CUSTOMIZATION NEEDED XXX
1523 # You will need to either create a circ mod for every expected medium type,
1524 # OR you should create a single circ mod for all requests from the external
1525 # system.
1526 # Adjust these lines as needed.
1527 # $copy->circ_modifier(qq($medium_type)); # XXX CUSTOMIZATION NEEDED XXX
1528 # OR
ba01d5da 1529 $copy->circ_modifier($conf->{copy}->{circ_modifier});
5f517e0a
DW
1530 $copy->barcode($barcode);
1531 $copy->call_number( $vol->{acn_id} );
ba01d5da 1532 $copy->circ_lib($conf->{copy}->{circ_lib});
5f517e0a
DW
1533 $copy->circulate('t');
1534 $copy->holdable('t');
1535 $copy->opac_visible('t');
1536 $copy->deleted('f');
1537 $copy->fine_level(2);
1538 $copy->loan_duration(2);
ba01d5da 1539 $copy->location($conf->{copy}->{location});
5f517e0a
DW
1540 $copy->status($copy_status_id);
1541 $copy->editor('1');
1542 $copy->creator('1');
1543
5f517e0a
DW
1544 $e->xact_begin;
1545 $copy = $e->create_asset_copy($copy);
1546
5f517e0a
DW
1547 $e->commit;
1548 return $e->event->{textcode} unless ($r);
1549 return 'SUCCESS';
4cdc4f67
JS
1550}
1551
1552# Checkout a copy to a patron
1553#
1554# Arguments
1555# copy barcode
1556# patron barcode
1557#
1558# Returns
1559# textcode of the OSRF response.
1ac548f2 1560sub checkout {
5f517e0a
DW
1561 check_session_time();
1562 my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1563
1564 # Check for copy:
1565 my $copy = copy_from_barcode($copy_barcode);
1566 unless ( defined($copy) && blessed($copy) ) {
1567 return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1568 }
1569
1570 # Check for user
b9103e62
JG
1571 my $uid;
1572 if ($patron_id_type eq 'barcode') {
1573 $uid = user_id_from_barcode($patron_barcode);
1574 } else {
1575 $uid = $patron_barcode;
1576 }
5f517e0a
DW
1577 return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1578
1579 my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1580 'open-ils.circ.checkout.full.override',
1581 $session{authtoken},
1582 {
1583 copy_barcode => $copy_barcode,
1584 patron_id => $uid,
1585 due_date => $due_date
1586 }
1587 )->gather(1);
1588 return $response->{textcode};
4cdc4f67
JS
1589}
1590
1ac548f2 1591sub renewal {
5f517e0a
DW
1592 check_session_time();
1593 my ( $copy_barcode, $due_date ) = @_;
1594
1595 # Check for copy:
1596 my $copy = copy_from_barcode($copy_barcode);
1597 unless ( defined($copy) && blessed($copy) ) {
1598 return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1599 }
1600
1601 my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1602 'open-ils.circ.renew.override',
1603 $session{authtoken},
1604 {
1605 copy_barcode => $copy_barcode,
1606 due_date => $due_date
1607 }
1608 )->gather(1);
1609 return $response->{textcode};
4cdc4f67
JS
1610}
1611
1ac548f2 1612# Check a copy in
4cdc4f67
JS
1613#
1614# Arguments
1615# copy barcode
4cdc4f67
JS
1616#
1617# Returns
1618# "SUCCESS" on success
1619# textcode of a failed OSRF request
0b0c5299 1620# 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
6e6bdfe9 1621
1ac548f2 1622sub checkin {
5f517e0a 1623 check_session_time();
d077d8de
DW
1624 my ($barcode, $noop) = @_;
1625 $noop ||= 0;
5f517e0a
DW
1626
1627 my $copy = copy_from_barcode($barcode);
1628 return $copy->{textcode} unless ( blessed $copy);
1629
1630 return ("COPY_NOT_CHECKED_OUT $barcode")
1631 unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1632
1633 my $e = new_editor( authtoken => $session{authtoken} );
1634 return $e->event->{textcode} unless ( $e->checkauth );
1635
1636 my $circ = $e->search_action_circulation(
1637 [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1638 my $r =
1639 OpenSRF::AppSession->create('open-ils.circ')
1640 ->request( 'open-ils.circ.checkin.override',
d077d8de 1641 $session{authtoken}, { force => 1, copy_id => $copy->id, noop => $noop } )->gather(1);
5f517e0a
DW
1642 return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1643 return $r->{textcode};
4cdc4f67
JS
1644}
1645
272651d1
JG
1646# Check in an copy as part of accept_item
1647# Intent is for the copy to be captured for
1648# a hold -- the only hold that should be
1649# present on the copy
1650
1651sub checkin_accept {
1652 check_session_time();
1653 my $copy_id = shift;
1654 my $circ_lib = shift;
1655
1656 my $r = OpenSRF::AppSession->create('open-ils.circ')->request(
1657 'open-ils.circ.checkin.override',
1658 $session{authtoken}, { force => 1, copy_id => $copy_id, circ_lib => $circ_lib }
1659 )->gather(1);
1660
1661 return $r->{textcode};
1662}
1663
4cdc4f67
JS
1664# Get actor.usr.id from barcode.
1665# Arguments
1666# patron barcode
1667#
1668# Returns
1669# actor.usr.id
1670# or hash on error
1671sub user_id_from_barcode {
5f517e0a
DW
1672 check_session_time();
1673 my ($barcode) = @_;
4cdc4f67 1674
5f517e0a 1675 my $response;
4cdc4f67 1676
5f517e0a
DW
1677 my $e = new_editor( authtoken => $session{authtoken} );
1678 return $response unless ( $e->checkauth );
4cdc4f67 1679
5f517e0a
DW
1680 my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1681 return $e->event unless ($card);
4cdc4f67 1682
5f517e0a 1683 $response = $card->[0]->usr if (@$card);
4cdc4f67 1684
5f517e0a 1685 $e->finish;
4cdc4f67 1686
5f517e0a 1687 return $response;
4cdc4f67
JS
1688}
1689
6e6bdfe9 1690# Place a simple hold for a patron.
4cdc4f67
JS
1691#
1692# Arguments
1693# Target object appropriate for type of hold
1694# Patron for whom the hold is place
1695#
1696# Returns
1697# "SUCCESS" on success
1698# textcode of a failed OSRF request
1699# "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1700# (Currently only support 'T' and 'C')
1701
1ac548f2 1702# simple hold should be removed and full holds sub should be used instead - pragmatic solution only
5082b884 1703
4cdc4f67 1704sub place_simple_hold {
5f517e0a 1705 check_session_time();
1ac548f2 1706
5f517e0a 1707 #my ($type, $target, $patron, $pickup_ou) = @_;
7e2d6432 1708 my ( $target, $patron_id ) = @_;
1ac548f2 1709
ba01d5da 1710 require $conf->{path}->{oils_header};
5f517e0a 1711 use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1ac548f2 1712
ba01d5da 1713 osrf_connect( $conf->{path}->{opensrf_core} );
f5e8d07e 1714 oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
7e2d6432
DW
1715 my $ahr = Fieldmapper::action::hold_request->new();
1716 $ahr->hold_type('C');
1717 # 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.
1718 $ahr->target($target);
1719 $ahr->usr($patron_id);
ba01d5da
JG
1720 $ahr->requestor($conf->{hold}->{requestor});
1721 # NOTE: When User Agency, we don't know the pickup location until ItemShipped time
1722 # TODO: When Item Agency and using holds, set this to requested copy's circ lib?
1723 $ahr->pickup_lib($conf->{hold}->{init_pickup_lib});
1724 $ahr->phone_notify(''); # TODO: set this based on usr prefs
1725 $ahr->email_notify(1); # TODO: set this based on usr prefs
7e2d6432
DW
1726 $ahr->frozen('t');
1727 my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1728 my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1729 $ahr = $e->retrieve_action_hold_request($resp); # refresh from db
9c7410f8
DW
1730 if (!ref $ahr) {
1731 $e->rollback;
1732 fail("place_simple_hold: hold request not placed!");
1733 }
7e2d6432
DW
1734 $ahr->frozen('f');
1735 $e->update_action_hold_request($ahr);
1736 $e->commit;
1737 $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
5f517e0a
DW
1738
1739 #oils_event_die($resp);
1740 my $errors = "";
1741 if ( ref($resp) eq 'ARRAY' ) {
1742 ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1743 return $errors;
1744 } elsif ( ref($resp) ne 'HASH' ) {
1745 return "Hold placed! hold_id = " . $resp . "\n";
1746 }
4cdc4f67
JS
1747}
1748
b5a02cf6 1749sub find_hold_on_copy {
3602ecf5
JG
1750 check_session_time();
1751
b5a02cf6 1752 my ( $copy_barcode ) = @_;
3602ecf5
JG
1753
1754 # start with barcode of item, find bib ID
1755 my $rec = bre_id_from_barcode($copy_barcode);
1756
c8f50ddf
JG
1757 return undef unless $rec;
1758
3602ecf5
JG
1759 # call for holds on that bib
1760 my $holds = holds_for_bre($rec);
1761
1762 # There should only be a single copy hold
1763 my $hold_id = @{$holds->{copy_holds}}[0];
1764
c8f50ddf
JG
1765 return undef unless $hold_id;
1766
3602ecf5
JG
1767 my $hold_details =
1768 OpenSRF::AppSession->create('open-ils.circ')
1769 ->request( 'open-ils.circ.hold.details.retrieve', $session{authtoken}, $hold_id )
1770 ->gather(1);
1771
1772 my $hold = $hold_details->{hold};
1773
c8f50ddf
JG
1774 return undef unless blessed($hold);
1775
b5a02cf6
JG
1776 return $hold;
1777}
1778
1779sub update_hold_pickup {
1780 check_session_time();
1781
1782 my ( $copy_barcode, $pickup_lib ) = @_;
1783
1784 my $hold = find_hold_on_copy($copy_barcode);
1785
7a3e1d58
JG
1786 # return if hold was not found
1787 return undef unless defined($hold) && blessed($hold);
1788
3602ecf5
JG
1789 $hold->pickup_lib($pickup_lib);
1790
b5a02cf6 1791 # update the copy hold with the new pickup lib information
3602ecf5
JG
1792 my $result =
1793 OpenSRF::AppSession->create('open-ils.circ')
1794 ->request( 'open-ils.circ.hold.update', $session{authtoken}, $hold )
1795 ->gather(1);
1796
1797 return $result;
1798}
1799
b874ff79
DW
1800sub cancel_hold {
1801 check_session_time();
1802
1803 my ( $copy_barcode ) = @_;
1804
1805 my $hold = find_hold_on_copy($copy_barcode);
1806
1807 # return if hold was not found
1808 return undef unless defined($hold) && blessed($hold);
1809
1810 $hold->cancel_time('now()');
1811 $hold->cancel_cause(5); # 5 = 'Staff forced' (perhaps it should be 'Patron via SIP'?) or OPAC? or add NCIP to the cause table?
1812 $hold->cancel_note('NCIP cancellation request');
1813
bb1d552c 1814 # update the (now cancelled) copy hold
b874ff79
DW
1815 my $result =
1816 OpenSRF::AppSession->create('open-ils.circ')
1817 ->request( 'open-ils.circ.hold.update', $session{authtoken}, $hold )
1818 ->gather(1);
1819
1820 return $result;
1821}
1822
4cdc4f67
JS
1823# Flesh user information
1824# Arguments
1825# actor.usr.id
1826#
1827# Returns
1828# fieldmapped, fleshed user or
1829# event hash on error
1830sub flesh_user {
5f517e0a
DW
1831 check_session_time();
1832 my ($id) = @_;
1833 my $response =
1834 OpenSRF::AppSession->create('open-ils.actor')
1835 ->request( 'open-ils.actor.user.fleshed.retrieve',
1836 $session{'authtoken'}, $id,
1837 [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1838 ->gather(1);
1839 return $response;
4cdc4f67 1840}
8b41455d
JG
1841
1842sub _naive_encode_xml {
1843 my $val = shift;
1844
1845 $val =~ s/&/&amp;/g;
1846 $val =~ s/</&lt;/g;
1847 $val =~ s/>/&gt;/g;
1848
1849 return $val;
1850}