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