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