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