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