Make invalid XML handling more robust, verbose
[sitka/iNCIPit.git] / iNCIPit.cgi
1 #! /usr/bin/perl 
2
3 #
4 # Copyleft 2014 Jon Scott <mr.jonathon.scott@gmail.com> 
5 # Copyleft 2014 Mark Cooper <mark.c.cooper@outlook.com> 
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 #
24 # This file is part of iNCIPit
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
37 # along with iNCIPit. If not, see <http://www.gnu.org/licenses/>.
38
39 use warnings;
40 use strict;
41 use XML::LibXML;
42 use CGI;
43 use HTML::Entities;
44 use CGI::Carp;
45 use OpenSRF::System;
46 use OpenSRF::Utils::SettingsClient;
47 use Digest::MD5 qw/md5_hex/;
48 use OpenILS::Utils::Fieldmapper;
49 use OpenILS::Utils::CStoreEditor qw/:funcs/;
50 use OpenILS::Const qw/:const/;
51 use Scalar::Util qw(reftype blessed);
52 use MARC::Record;
53 use MARC::Field;
54 use MARC::File::XML;
55 use POSIX qw/strftime/;
56 use DateTime;
57 use Config::Tiny;
58
59 my $U = "OpenILS::Application::AppUtils";
60
61 my $cgi = CGI->new();
62 my $xml = $cgi->param('POSTDATA');# || $cgi->param('XForms:Model');
63 my $host = $cgi->url(-base=>1);
64 my $hostname = (split "/", $host)[2]; # base hostname i.e. www.example.org
65 my $conffile = "$hostname.ini"; # hostname specific ini file i.e. www.example.org.ini
66 my $conf;
67
68 # attempt to load configuration file using matching request hostname, fallback to default
69 if (-e $conffile) {
70         $conf = load_config($conffile);
71 } else {
72         $conffile = "iNCIPit.ini";
73         $conf = load_config($conffile);
74 }
75
76 # Set some variables from config (or defaults)
77
78 # Default patron_identifier type is barcode
79 my $patron_id_type = "barcode";
80
81 # if the config specifies a patron_identifier type
82 if (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     }
88 }
89
90 # reject non-https access unless configured otherwise
91 unless ($conf->{access}->{permit_plaintext} =~ m/^yes$/i) {
92     unless (defined($ENV{HTTPS}) && $ENV{HTTPS} eq 'on') {
93         print "Content-type: text/plain\n\n";
94         print "Access denied.\n";
95         exit 0;
96     }
97 }
98
99 # TODO: support for multiple load balancer IPs
100 my $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
104 if ($lb_ip) {
105     my @allowed_ips = split(/ *, */, $conf->{access}->{allowed_client_ips});
106
107     my $forwarded = $ENV{HTTP_X_FORWARDED_FOR};
108     my $ok = 0;
109
110     foreach my $check_ip (@allowed_ips) {
111         $ok = 1 if ($check_ip eq $forwarded);
112     }
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
118     unless ($ok && $ENV{REMOTE_ADDR} eq $lb_ip) {
119         print "Content-type: text/plain\n\n";
120         print "Access denied.\n";
121         exit 0;
122     }
123 }
124
125
126 # log request hostname, configuration file used and posted data
127 # XXX: posted ncip message log filename should be in config.
128 open POST_DATA, ">>post_data.txt";
129 print POST_DATA "INCOMING REQUEST\t$hostname\n";
130 print POST_DATA "CONFIGURATION FILE\t$conffile\n";
131 print POST_DATA "$xml\n";
132 close POST_DATA;
133
134 # initialize the parser
135 my $parser = new XML::LibXML;
136 my $doc;
137
138 # Attempt to parse XML without any modification
139 eval {
140     $doc = $parser->load_xml( string => $xml );
141 };
142
143 # Attempt to gracefully handle invalid XML, including mitigations for known common issues.
144 if ($@ && 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     }
180 }
181
182 fail("XML parsing did not result in a document.") unless $doc && ref($doc) eq 'XML::LibXML::Document';
183
184 my %session = login();
185
186 if ( defined( $session{authtoken} ) ) {
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
202     logout();
203 } else {
204     fail("Unable to perform action : Unknown Service Request");
205 }
206
207 # load and parse config file
208 sub 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
217 # load and parse userpriv_map file, returning a hashref
218 sub load_map_file {
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
232 sub 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
242 sub 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
252 sub logit {
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);
259 }
260
261 sub staff_log {
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;
267 }
268
269 sub item_renew {
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;
284 Content-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">
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>
308 </NCIPMessage> 
309
310 ITEMRENEWAL
311
312     my $more_info = <<MOREINFO;
313
314 VISID             = $visid
315 Desired Due Date     = $due_date
316
317 MOREINFO
318
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 );
327 }
328
329 sub renew_item {
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');
338     my $unique_item_id = $doc->findvalue('/NCIPMessage/RenewItem/UniqueItemId/ItemIdentifierValue');
339     my $due_date = $doc->findvalue('/NCIPMessage/RenewItem/DateDue');
340
341     # we are using the UniqueItemId value as a barcode here
342     my $r = renewal( $unique_item_id, $due_date );
343
344     my $hd = <<ITEMRENEWAL;
345 Content-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">
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>
366             <ItemIdentifierValue datatype="string">$unique_item_id</ItemIdentifierValue>
367         </UniqueItemId>
368     </RenewItemResponse>
369 </NCIPMessage> 
370
371 ITEMRENEWAL
372
373     my $more_info = <<MOREINFO;
374
375 UNIQUEID             = $unique_item_id
376 Desired Due Date     = $due_date
377
378 MOREINFO
379
380     logit( $hd, ( caller(0) )[3], $more_info );
381     staff_log( $taidValue, $faidValue,
382             "RenewItem -> Patronid : "
383           . $pid
384           . " | Uniqueid: : "
385           . $unique_item_id
386           . " | Due Date : "
387           . $due_date );
388 }
389
390 sub accept_item {
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');
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);
401     fail( "accept_item: " . $copy->{textcode} . " $visid" ) unless ( blessed $copy);
402     my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
403     # We need to find the hold to know the pickup location
404     my $hold = find_hold_on_copy($visid);
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     }
412
413     my $hd = <<ACCEPTITEM;
414 Content-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">
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>
441 </NCIPMessage> 
442
443 ACCEPTITEM
444
445     logit( $hd, ( caller(0) )[3] );
446     staff_log( $taidValue, $faidValue,
447         "AcceptItem -> Request Id : " . $request_id . " | Patron Id : " . $patron . " | Visible Id :" . $visid );
448 }
449
450 sub item_received {
451     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
452     my $faidScheme = HTML::Entities::encode($faidSchemeX);
453     my $faidValue = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
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');
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
461     my $r2 = delete_copy($copy);
462
463     my $hd = <<ITEMRECEIVED;
464 Content-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">
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>
485             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
486         </UniqueItemId>
487     </ItemReceivedResponse>
488 </NCIPMessage> 
489
490 ITEMRECEIVED
491
492     logit( $hd, ( caller(0) )[3] );
493     staff_log( $taidValue, $faidValue, "ItemReceived -> Visible ID : " . $visid );
494 }
495
496 sub item_cancelled {
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);
518         my $r = update_copy( $copy, 0 ); # TODO: we need to actually remove the hold, not just reset to available
519     }
520
521     my $hd = <<ITEMREQUESTCANCELLED;
522 Content-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">
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>
546 </NCIPMessage> 
547
548 ITEMREQUESTCANCELLED
549
550     logit( $hd, ( caller(0) )[3] );
551     staff_log( $taidValue, $faidValue,
552         "ItemRequestCancelled -> Barcode : " . $barcode );
553 }
554
555 sub item_checked_in {
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
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);
567     my $r2 = update_copy( $copy, $conf->{status}->{transit_return} ); # "INN-Reach Transit Return" status
568
569     my $hd = <<ITEMCHECKEDIN;
570 Content-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">
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>
591             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
592         </UniqueItemId>
593     </ItemCheckedInResponse>
594 </NCIPMessage> 
595
596 ITEMCHECKEDIN
597
598     logit( $hd, ( caller(0) )[3] );
599     staff_log( $taidValue, $faidValue, "ItemCheckedIn -> Visible ID : " . $visid );
600 }
601
602 sub item_checked_out {
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
610     my $patron_barcode = $doc->findvalue('/NCIPMessage/ItemCheckedOut/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
611     my $due_date = $doc->findvalue('/NCIPMessage/ItemCheckedOut/DateDue');
612     my $visid = $doc->findvalue('/NCIPMessage/ItemCheckedOut/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
613
614     my $copy = copy_from_barcode($visid);
615     fail( $copy->{textcode} . " $visid" ) unless ( blessed $copy);
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 );
619
620     my $hd = <<ITEMCHECKEDOUT;
621 Content-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">
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>
645 </NCIPMessage> 
646
647 ITEMCHECKEDOUT
648
649     logit( $hd, ( caller(0) )[3] );
650     staff_log( $taidValue, $faidValue,
651         "ItemCheckedOut -> Visible Id : " . $visid . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
652 }
653
654 sub check_out_item {
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');
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
665
666     # For CheckOutItem and INN-REACH, this value will correspond with our local barcode
667     my $barcode = $doc->findvalue('/NCIPMessage/CheckOutItem/UniqueItemId/ItemIdentifierValue');
668
669     # TODO: watch for possible real ids here?
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
675     my $r2 = checkout( $barcode, $patron_barcode, $due_date );
676
677     # TODO: check for checkout exception (like OPEN_CIRCULATION_EXISTS)
678
679     my $hd = <<CHECKOUTITEM;
680 Content-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">
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>
704 </NCIPMessage> 
705
706 CHECKOUTITEM
707
708     logit( $hd, ( caller(0) )[3] );
709     staff_log( $taidValue, $faidValue,
710         "CheckOutItem -> Barcode : " . $barcode . " | Patron Barcode : " . $patron_barcode . " | Due Date : " . $due_date );
711 }
712
713 sub check_in_item {
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
721     # For CheckInItem and INN-REACH, this value will correspond with our local barcode
722     my $barcode = $doc->findvalue('/NCIPMessage/CheckInItem/UniqueItemId/ItemIdentifierValue');
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 
729
730     my $hd = <<CHECKINITEM;
731 Content-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">
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>
755 </NCIPMessage> 
756
757 CHECKINITEM
758
759     logit( $hd, ( caller(0) )[3] );
760     staff_log( $taidValue, $faidValue, "CheckInItem -> Barcode : " . $barcode );
761 }
762
763 sub item_shipped {
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
771     my $address = $doc->findvalue('/NCIPMessage/ItemShipped/ShippingInformation/PhysicalAddress/UnstructuredAddress/UnstructuredAddressData');
772
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);
779
780     fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
781
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
796     my $r = update_copy_shipped( $copy, $conf->{status}->{transit}, $visid ); # put copy into INN-Reach Transit status & modify barcode = Visid != tempIIIiNumber
797
798     my $hd = <<ITEMSHIPPED;
799 Content-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">
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>
823 </NCIPMessage> 
824
825 ITEMSHIPPED
826
827     logit( $hd, ( caller(0) )[3] );
828     staff_log( $taidValue, $faidValue,
829         "ItemShipped -> Visible Id : " . $visid . " | Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber );
830 }
831
832 sub item_request {
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
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');
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
853     if ( $barcode =~ /^i/ ) {    # XXX EG is User Agency # create copy only if barcode is an iNUMBER
854         my $copy_status_id = $conf->{status}->{loan_requested}; # INN-Reach Loan Requested - local configured status
855         $barcode .= $faidValue;
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
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         }
869     }
870
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
876     my $hd = <<ITEMREQ;
877 Content-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">
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>
902             <UserIdentifierValue datatype="string">$pid</UserIdentifierValue>
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>
917 </NCIPMessage> 
918
919 ITEMREQ
920
921     logit( $hd, ( caller(0) )[3] );
922     staff_log( $taidValue, $faidValue,
923         "ItemRequested -> Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber . " | Patronid :" . $pid );
924 }
925
926 sub lookupUser {
927
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');
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     }
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
952     my ( $propername, $email, $good_until, $userpriv, $block_stanza ) =
953       ( "name here", "", "good until", "", "" );    # defaults
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
1003     if ( defined( $patron->email ) && $conf->{behavior}->{omit_patron_email} !~ m/^y/i ) {
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";
1020     $userpriv = $patron->profile->name;
1021
1022     my $userpriv_map = load_map_file( $conf->{path}->{userpriv_map} );
1023
1024     if ($userpriv_map) {
1025         $userpriv = lookup_userpriv($userpriv, $userpriv_map);
1026     }
1027
1028     #} else {
1029     #    do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
1030     #    die;
1031     #}
1032     my $uniqid = $patron->id;
1033     my $visid;
1034     if ($patron_id_type eq 'barcode') {
1035         $visid = $patron->card->barcode;
1036     } else {
1037         $visid = $patron->id;
1038     }
1039     my $hd = <<LOOKUPUSERRESPONSE;
1040 Content-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">
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>
1065             <UserIdentifierValue>$uniqid</UserIdentifierValue>
1066         </UniqueUserId>
1067         <UserOptionalFields>
1068             <VisibleUserId>
1069                 <VisibleUserIdentifierType>
1070                     <Scheme datatype="string">http://blah.com</Scheme>
1071                     <Value datatype="string">Barcode</Value>
1072                 </VisibleUserIdentifierType>
1073                 <VisibleUserIdentifier datatype="string">$visid</VisibleUserIdentifier>
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>
1087                     <Value datatype="string">$userpriv</Value>
1088                 </AgencyUserPrivilegeType>
1089                 <ValidToDate datatype="string">$good_until</ValidToDate>
1090             </UserPrivilege> $email $block_stanza
1091         </UserOptionalFields>
1092    </LookupUserResponse>
1093 </NCIPMessage>
1094
1095 LOOKUPUSERRESPONSE
1096
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 );
1107 }
1108
1109 sub fail {
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";
1113
1114     print <<ITEMREQ;
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">
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>
1133 </NCIPMessage>
1134
1135 ITEMREQ
1136
1137     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1138     staff_log( '', '',
1139         ( ( caller(0) )[3] . " -> " . $error_msg ) );
1140     die;
1141 }
1142
1143 sub do_lookup_user_error_stanza {
1144
1145     # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
1146     my $error = shift;
1147     my $hd    = <<LOOKUPPROB;
1148 Content-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">
1153     <LookupUserResponse>
1154         <ResponseHeader>
1155             <FromAgencyId>
1156                 <UniqueAgencyId>
1157                     <Scheme></Scheme>
1158                     <Value></Value>
1159                 </UniqueAgencyId>
1160             </FromAgencyId>
1161             <ToAgencyId>
1162                 <UniqueAgencyId>
1163                     <Scheme></Scheme>
1164                     <Value></Value>
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>
1180 </NCIPMessage>
1181
1182 LOOKUPPROB
1183
1184     logit( $hd, ( caller(0) )[3] );
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 ) );
1187     die;
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).
1194 sub login {
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.
1198     my $bootstrap = '/openils/conf/opensrf_core.xml';
1199     my $uname     = $conf->{auth}->{username};
1200     my $password  = $conf->{auth}->{password};
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;
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
1244 sub check_session_time {
1245     if ( time() > $session{'expiration'} ) {
1246         %session = login();
1247         if ( !%session ) {
1248             die("Failed to reinitialize the session after expiration.");
1249         }
1250     }
1251 }
1252
1253 # Retrieve the logged in user.
1254 #
1255 sub get_session {
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;
1261 }
1262
1263 # Logout/destroy the OpenSRF session
1264 #
1265 # Argument is
1266 # none
1267 #
1268 # Returns
1269 # Does not return anything
1270 sub logout {
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     }
1284 }
1285
1286 sub update_copy {
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';
1296 }
1297
1298 # my paranoia re barcode on shipped items using visid for unique value
1299 sub update_copy_shipped {
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';
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
1320 sub delete_copy {
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.
1336     # TODO: I think there is a utility function which handles all this
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         }
1354         $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
1355         unless (@$list) {
1356             $r = $e->delete_biblio_record_entry($bre);
1357             unless ($r) {
1358                 my $lval = $e->event->{textcode};
1359                 $e->rollback;
1360                 return $lval;
1361             }
1362         }
1363     }
1364     $e->commit;
1365     return 'SUCCESS';
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
1375 sub copy_from_barcode {
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;
1383 }
1384
1385 sub locid_from_barcode {
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];
1392 }
1393
1394 sub 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
1404 sub 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
1415 # Convert a MARC::Record to XML for Evergreen
1416 #
1417 # Copied from Dyrcona's issa framework which copied
1418 # it from MVLC's Safari Load program which copied it
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
1426 sub convert2marcxml {
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;
1432     $xml = $U->entityize($xml);
1433     $xml =~ s/[\x00-\x1f]//go;
1434     return $xml;
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
1447 sub create_copy {
1448     check_session_time();
1449     my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
1450
1451     my $e = new_editor( authtoken => $session{authtoken} );
1452     return $e->event->{textcode} unless ( $e->checkauth );
1453
1454     my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1455     if ( ref($r) eq 'HASH' ) {
1456         return $r->{textcode} . ' ' . $r->{ilsperm};
1457     }
1458
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) {
1462 # in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
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')
1491       ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, $conf->{volume}->{owning_lib} )
1492       ->gather(1);
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();
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
1507     $copy->circ_modifier($conf->{copy}->{circ_modifier});
1508     $copy->barcode($barcode);
1509     $copy->call_number( $vol->{acn_id} );
1510     $copy->circ_lib($conf->{copy}->{circ_lib});
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);
1517     $copy->location($conf->{copy}->{location});
1518     $copy->status($copy_status_id);
1519     $copy->editor('1');
1520     $copy->creator('1');
1521
1522     $e->xact_begin;
1523     $copy = $e->create_asset_copy($copy);
1524
1525     $e->commit;
1526     return $e->event->{textcode} unless ($r);
1527     return 'SUCCESS';
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.
1538 sub checkout {
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
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     }
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};
1567 }
1568
1569 sub renewal {
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};
1588 }
1589
1590 # Check a copy in
1591 #
1592 # Arguments
1593 # copy barcode
1594 #
1595 # Returns
1596 # "SUCCESS" on success
1597 # textcode of a failed OSRF request
1598 # 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
1599
1600 sub checkin {
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};
1621 }
1622
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
1628 sub 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
1641 # Get actor.usr.id from barcode.
1642 # Arguments
1643 # patron barcode
1644 #
1645 # Returns
1646 # actor.usr.id
1647 # or hash on error
1648 sub user_id_from_barcode {
1649     check_session_time();
1650     my ($barcode) = @_;
1651
1652     my $response;
1653
1654     my $e = new_editor( authtoken => $session{authtoken} );
1655     return $response unless ( $e->checkauth );
1656
1657     my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1658     return $e->event unless ($card);
1659
1660     $response = $card->[0]->usr if (@$card);
1661
1662     $e->finish;
1663
1664     return $response;
1665 }
1666
1667 # Place a simple hold for a patron.
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
1679 # simple hold should be removed and full holds sub should be used instead - pragmatic solution only
1680
1681 sub place_simple_hold {
1682     check_session_time();
1683
1684     #my ($type, $target, $patron, $pickup_ou) = @_;
1685     my ( $target, $patron_id ) = @_;
1686
1687     require $conf->{path}->{oils_header};
1688     use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1689
1690     osrf_connect( $conf->{path}->{opensrf_core} );
1691     oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
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);
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
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 );
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     }
1720 }
1721
1722 sub find_hold_on_copy {
1723     check_session_time();
1724
1725     my ( $copy_barcode ) = @_;
1726
1727     # start with barcode of item, find bib ID
1728     my $rec = bre_id_from_barcode($copy_barcode);
1729
1730     return undef unless $rec;
1731
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
1738     return undef unless $hold_id;
1739
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
1747     return undef unless blessed($hold);
1748
1749     return $hold;
1750 }
1751
1752 sub 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
1759     # return if hold was not found
1760     return undef unless defined($hold) && blessed($hold);
1761
1762     $hold->pickup_lib($pickup_lib);
1763
1764     # update the copy hold with the new pickup lib information
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
1773 # Flesh user information
1774 # Arguments
1775 # actor.usr.id
1776 #
1777 # Returns
1778 # fieldmapped, fleshed user or
1779 # event hash on error
1780 sub flesh_user {
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;
1790 }