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