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