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