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