Add option to skip item agency ItemRequested holds
[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         unless ( $conf->{behavior}->{no_item_agency_holds} =~ m/^y/i ) {
712             # place hold for user UniqueUserId/UniqueAgencyId/Value = institution account
713             my $copy = copy_from_barcode($barcode);
714             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
715             $r = place_simple_hold( $copy->id, $pid2 );
716             my $r2 = update_copy( $copy, $conf->{status}->{hold} ); # put into INN-Reach Hold status
717         }
718     }
719
720     my $hd = <<ITEMREQ;
721 Content-type: text/xml
722
723
724 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
725 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
726     <ItemRequestedResponse>
727         <ResponseHeader>
728             <FromAgencyId>
729                 <UniqueAgencyId>
730                     <Scheme>$faidScheme</Scheme>
731                     <Value>$faidValue</Value>
732                 </UniqueAgencyId>
733             </FromAgencyId>
734             <ToAgencyId>
735                 <UniqueAgencyId>
736                     <Scheme>$taidScheme</Scheme>
737                     <Value>$taidValue</Value>
738                 </UniqueAgencyId>
739             </ToAgencyId>
740         </ResponseHeader>
741         <UniqueUserId>
742             <UniqueAgencyId>
743                 <Scheme datatype="string">$taidScheme</Scheme>
744                 <Value datatype="string">$taidValue</Value>
745             </UniqueAgencyId>
746             <UserIdentifierValue datatype="string">$pid</UserIdentifierValue>
747         </UniqueUserId>
748         <UniqueItemId>
749             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
750         </UniqueItemId>
751         <ItemOptionalFields>
752             <BibliographicDescription>
753         <Author datatype="string">$author</Author>
754         <Title datatype="string">$title</Title>
755             </BibliographicDescription>
756             <ItemDescription>
757                 <CallNumber datatype="string">$callnumber</CallNumber>
758             </ItemDescription>
759        </ItemOptionalFields>
760     </ItemRequestedResponse>
761 </NCIPMessage> 
762
763 ITEMREQ
764
765     logit( $hd, ( caller(0) )[3] );
766     staff_log( $taidValue, $faidValue,
767         "ItemRequested -> Barcode : " . $barcode . " | Title : " . $title . " | Call Number : " . $callnumber . " | Patronid :" . $pid );
768 }
769
770 sub lookupUser {
771
772     my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
773     $faidScheme = HTML::Entities::encode($faidScheme);
774     my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
775     my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
776     $taidScheme = HTML::Entities::encode($taidScheme);
777
778     my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
779     my $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
780     my $uidValue = user_id_from_barcode($id);
781
782     if ( !defined($uidValue)
783         || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
784     {
785         do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
786         die;
787     }
788
789     my ( $propername, $email, $good_until, $userprivid, $block_stanza ) =
790       ( "name here", "", "good until", "0", "" );    # defaults
791
792     my $patron = flesh_user($uidValue);
793
794     #if (blessed($patron)) {
795     my $patron_ok = 1;
796     my @penalties = @{ $patron->standing_penalties };
797
798     if ( $patron->deleted eq 't' ) {
799         do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
800         die;
801     } elsif ( $patron->barred eq 't' ) {
802         do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
803         die;
804     } elsif ( $patron->active eq 'f' ) {
805         do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
806         die;
807     }
808
809     elsif ( $#penalties > -1 ) {
810
811 #                my $penalty;
812 #                   foreach $penalty (@penalties) {
813 #                    if (defined($penalty->standing_penalty->block_list)) {
814 #                            my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
815 #                            foreach my $block (@block_list) {
816 #                                foreach my $block_on (@$block_types) {
817 #                                    if ($block eq $block_on) {
818 #                                        $block_stanza .= "\n".$penalty->standing_penalty->name;
819 #                                        $patron_ok = 0;
820 #                                    }
821 #                                    last unless ($patron_ok);
822 #                            }
823 #                                last unless ($patron_ok);
824 #                          }
825 #                     }
826 #                }
827         $block_stanza = qq(
828             <BlockOrTrap>
829                 <UniqueAgencyId>
830                     <Scheme datatype="string">http://just.testing.now</Scheme>
831                     <Value datatype="string">$faidValue</Value>
832                 </UniqueAgencyId>
833                 <BlockOrTrapType>
834                     <Scheme datatype="string">http://just.testing.now</Scheme>
835                     <Value datatype="string">Block Hold</Value>
836                 </BlockOrTrapType>
837             </BlockOrTrap>);
838     }
839
840     if ( defined( $patron->email ) ) {
841         $email = qq(
842             <UserAddressInformation>
843                 <ElectronicAddress>
844                     <ElectronicAddressType>
845                         <Scheme datatype="string">http://testing.now</Scheme>
846                         <Value datatype="string">mailto</Value>
847                     </ElectronicAddressType>
848                     <ElectronicAddressData datatype="string">)
849           . HTML::Entities::encode( $patron->email )
850           . qq(</ElectronicAddressData>
851                 </ElectronicAddress>
852             </UserAddressInformation>);
853     }
854
855     $propername = $patron->first_given_name . " " . $patron->family_name;
856     $good_until = $patron->expire_date || "unknown";
857     $userprivid = $patron->profile;
858     my $userou   = $patron->home_ou->name;
859     my $userpriv = $patron->profile->name;
860
861     #} else {
862     #    do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
863     #    die;
864     #}
865     my $uniqid = $patron->id;
866     my $visid  = $patron->card->barcode;
867     my $hd = <<LOOKUPUSERRESPONSE;
868 Content-type: text/xml
869
870
871 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
872 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
873     <LookupUserResponse>
874         <ResponseHeader>
875             <FromAgencyId>
876                 <UniqueAgencyId>
877                     <Scheme>$taidScheme</Scheme>
878                     <Value>$taidValue</Value>
879                 </UniqueAgencyId>
880             </FromAgencyId>
881             <ToAgencyId>
882                 <UniqueAgencyId>
883                    <Scheme>$faidScheme</Scheme>
884                    <Value>$faidValue</Value>
885                 </UniqueAgencyId>
886             </ToAgencyId>
887         </ResponseHeader>
888         <UniqueUserId>
889             <UniqueAgencyId>
890                 <Scheme>$taidScheme</Scheme>
891                 <Value>$taidValue</Value>
892             </UniqueAgencyId>
893             <UserIdentifierValue>$uniqid</UserIdentifierValue>
894         </UniqueUserId>
895         <UserOptionalFields>
896             <VisibleUserId>
897                 <VisibleUserIdentifierType>
898                     <Scheme datatype="string">http://blah.com</Scheme>
899                     <Value datatype="string">Barcode</Value>
900                 </VisibleUserIdentifierType>
901                 <VisibleUserIdentifier datatype="string">$visid</VisibleUserIdentifier>
902             </VisibleUserId>
903             <NameInformation>
904                 <PersonalNameInformation>
905                     <UnstructuredPersonalUserName datatype="string">$propername</UnstructuredPersonalUserName>
906                 </PersonalNameInformation>
907             </NameInformation>
908             <UserPrivilege>
909                 <UniqueAgencyId>
910                     <Scheme datatype="string">$faidScheme</Scheme>
911                     <Value datatype="string">$faidValue</Value>
912                 </UniqueAgencyId>
913                 <AgencyUserPrivilegeType>
914                     <Scheme datatype="string">http://testing.purposes.only</Scheme>
915                     <Value datatype="string">$userprivid</Value>
916                 </AgencyUserPrivilegeType>
917                 <ValidToDate datatype="string">$good_until</ValidToDate>
918             </UserPrivilege> $email $block_stanza
919         </UserOptionalFields>
920    </LookupUserResponse>
921 </NCIPMessage>
922
923 LOOKUPUSERRESPONSE
924
925     logit( $hd, ( caller(0) )[3] );
926     staff_log( $taidValue, $faidValue,
927             "LookupUser -> Patron Barcode : "
928           . $id
929           . " | Patron Id : "
930           . $uidValue
931           . " | User Name : "
932           . $propername
933           . " | User Priv : "
934           . $userpriv );
935 }
936
937 sub fail {
938     my $error_msg =
939       shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
940     print "Content-type: text/xml\n\n";
941
942     print <<ITEMREQ;
943 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
944 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
945     <ItemRequestedResponse>
946         <ResponseHeader>
947             <FromAgencyId>
948                 <UniqueAgencyId>
949                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
950                     <Value></Value>
951                 </UniqueAgencyId>
952             </FromAgencyId>
953             <ToAgencyId>
954                 <UniqueAgencyId>
955                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
956                     <Value>$error_msg</Value>
957                 </UniqueAgencyId>
958             </ToAgencyId>
959         </ResponseHeader>
960     </ItemRequestedResponse>
961 </NCIPMessage>
962
963 ITEMREQ
964
965     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
966     staff_log( '', '',
967         ( ( caller(0) )[3] . " -> " . $error_msg ) );
968     die;
969 }
970
971 sub do_lookup_user_error_stanza {
972
973     # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
974     my $error = shift;
975     my $hd    = <<LOOKUPPROB;
976 Content-type: text/xml
977
978
979 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
980 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
981     <LookupUserResponse>
982         <ResponseHeader>
983             <FromAgencyId>
984                 <UniqueAgencyId>
985                     <Scheme></Scheme>
986                     <Value></Value>
987                 </UniqueAgencyId>
988             </FromAgencyId>
989             <ToAgencyId>
990                 <UniqueAgencyId>
991                     <Scheme></Scheme>
992                     <Value></Value>
993                 </UniqueAgencyId>
994             </ToAgencyId>
995         </ResponseHeader>
996         <Problem>
997             <ProcessingError>
998                 <ProcessingErrorType>
999                     <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
1000                     <Value>$error</Value>
1001                 </ProcessingErrorType>
1002                 <ProcessingErrorElement>
1003                     <ElementName>AuthenticationInput</ElementName>
1004                 </ProcessingErrorElement>
1005             </ProcessingError>
1006         </Problem>
1007     </LookupUserResponse>
1008 </NCIPMessage>
1009
1010 LOOKUPPROB
1011
1012     logit( $hd, ( caller(0) )[3] );
1013     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
1014     staff_log( '', '', ( ( caller(0) )[3] . " -> " . $error ) );
1015     die;
1016 }
1017
1018 # Login to the OpenSRF system/Evergreen.
1019 #
1020 # Returns a hash with the authtoken, authtime, and expiration (time in
1021 # seconds since 1/1/1970).
1022 sub login {
1023
1024  # XXX: local opensrf core conf filename should be in config.
1025  # XXX: STAFF account with ncip service related permissions should be in config.
1026     my $bootstrap = '/openils/conf/opensrf_core.xml';
1027     my $uname     = $conf->{auth}->{username};
1028     my $password  = $conf->{auth}->{password};
1029
1030     # Bootstrap the client
1031     OpenSRF::System->bootstrap_client( config_file => $bootstrap );
1032     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
1033     Fieldmapper->import( IDL => $idl );
1034
1035     # Initialize CStoreEditor:
1036     OpenILS::Utils::CStoreEditor->init;
1037
1038     my $seed = OpenSRF::AppSession->create('open-ils.auth')
1039       ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1040
1041     return undef unless $seed;
1042
1043     my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1044         'open-ils.auth.authenticate.complete',
1045         {
1046             username => $uname,
1047             password => md5_hex( $seed . md5_hex($password) ),
1048             type     => 'staff'
1049         }
1050     )->gather(1);
1051
1052     return undef unless $response;
1053
1054     my %result;
1055     $result{'authtoken'}  = $response->{payload}->{authtoken};
1056     $result{'authtime'}   = $response->{payload}->{authtime};
1057     $result{'expiration'} = time() + $result{'authtime'}
1058       if ( defined( $result{'authtime'} ) );
1059     return %result;
1060 }
1061
1062 # Check the time versus the session expiration time and login again if
1063 # the session has expired, consequently resetting the session
1064 # paramters. We want to run this before doing anything that requires
1065 # us to have a current session in OpenSRF.
1066 #
1067 # Arguments
1068 # none
1069 #
1070 # Returns
1071 # Nothing
1072 sub check_session_time {
1073     if ( time() > $session{'expiration'} ) {
1074         %session = login();
1075         if ( !%session ) {
1076             die("Failed to reinitialize the session after expiration.");
1077         }
1078     }
1079 }
1080
1081 # Retrieve the logged in user.
1082 #
1083 sub get_session {
1084     my $response =
1085       OpenSRF::AppSession->create('open-ils.auth')
1086       ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1087       ->gather(1);
1088     return $response;
1089 }
1090
1091 # Logout/destroy the OpenSRF session
1092 #
1093 # Argument is
1094 # none
1095 #
1096 # Returns
1097 # Does not return anything
1098 sub logout {
1099     if ( time() < $session{'expiration'} ) {
1100         my $response =
1101           OpenSRF::AppSession->create('open-ils.auth')
1102           ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1103           ->gather(1);
1104         if ($response) {
1105
1106             # strong.silent.success
1107             exit(0);
1108         } else {
1109             fail("Logout unsuccessful. Good-bye, anyway.");
1110         }
1111     }
1112 }
1113
1114 sub update_copy {
1115     check_session_time();
1116     my ( $copy, $status_id ) = @_;
1117     my $e = new_editor( authtoken => $session{authtoken} );
1118     return $e->event->{textcode} unless ( $e->checkauth );
1119     $e->xact_begin;
1120     $copy->status($status_id);
1121     return $e->event unless $e->update_asset_copy($copy);
1122     $e->commit;
1123     return 'SUCCESS';
1124 }
1125
1126 # my paranoia re barcode on shipped items using visid for unique value
1127 sub update_copy_shipped {
1128     check_session_time();
1129     my ( $copy, $status_id, $barcode ) = @_;
1130     my $e = new_editor( authtoken => $session{authtoken} );
1131     return $e->event->{textcode} unless ( $e->checkauth );
1132     $e->xact_begin;
1133     $copy->status($status_id);
1134     $copy->barcode($barcode);
1135     return $e->event unless $e->update_asset_copy($copy);
1136     $e->commit;
1137     return 'SUCCESS';
1138 }
1139
1140 # Delete a copy
1141 #
1142 # Argument
1143 # Fieldmapper asset.copy object
1144 #
1145 # Returns
1146 # "SUCCESS" on success
1147 # Event textcode if an error occurs
1148 sub delete_copy {
1149     check_session_time();
1150     my ($copy) = @_;
1151
1152     my $e = new_editor( authtoken => $session{authtoken} );
1153     return $e->event->{textcode} unless ( $e->checkauth );
1154
1155     # Get the calnumber
1156     my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1157     return $e->event->{textcode} unless ($vol);
1158
1159     # Get the biblio.record_entry
1160     my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1161     return $e->event->{textcode} unless ($bre);
1162
1163     # Delete everything in a transaction and rollback if anything fails.
1164     # TODO: I think there is a utility function which handles all this
1165     $e->xact_begin;
1166     my $r;    # To hold results of editor calls
1167     $r = $e->delete_asset_copy($copy);
1168     unless ($r) {
1169         my $lval = $e->event->{textcode};
1170         $e->rollback;
1171         return $lval;
1172     }
1173     my $list =
1174       $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1175     unless (@$list) {
1176         $r = $e->delete_asset_call_number($vol);
1177         unless ($r) {
1178             my $lval = $e->event->{textcode};
1179             $e->rollback;
1180             return $lval;
1181         }
1182         $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
1183         unless (@$list) {
1184             $r = $e->delete_biblio_record_entry($bre);
1185             unless ($r) {
1186                 my $lval = $e->event->{textcode};
1187                 $e->rollback;
1188                 return $lval;
1189             }
1190         }
1191     }
1192     $e->commit;
1193     return 'SUCCESS';
1194 }
1195
1196 # Get asset.copy from asset.copy.barcode.
1197 # Arguments
1198 # copy barcode
1199 #
1200 # Returns
1201 # asset.copy fieldmaper object
1202 # or hash on error
1203 sub copy_from_barcode {
1204     check_session_time();
1205     my ($barcode) = @_;
1206     my $response =
1207       OpenSRF::AppSession->create('open-ils.search')
1208       ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1209       ->gather(1);
1210     return $response;
1211 }
1212
1213 sub locid_from_barcode {
1214     my ($barcode) = @_;
1215     my $response =
1216       OpenSRF::AppSession->create('open-ils.search')
1217       ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1218       ->gather(1);
1219     return $response->{ids}[0];
1220 }
1221
1222 # Convert a MARC::Record to XML for Evergreen
1223 #
1224 # Copied from Dyrcona's issa framework which copied
1225 # it from MVLC's Safari Load program which copied it
1226 # from some code in the Open-ILS example import scripts.
1227 #
1228 # Argument
1229 # A MARC::Record object
1230 #
1231 # Returns
1232 # String with XML for the MARC::Record as Evergreen likes it
1233 sub convert2marcxml {
1234     my $input = shift;
1235     ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1236     $xml =~ s/^<\?xml.+\?\s*>//go;
1237     $xml =~ s/>\s+</></go;
1238     $xml =~ s/\p{Cc}//go;
1239     $xml = $U->entityize($xml);
1240     $xml =~ s/[\x00-\x1f]//go;
1241     return $xml;
1242 }
1243
1244 # Create a copy and marc record
1245 #
1246 # Arguments
1247 # title
1248 # call number
1249 # copy barcode
1250 #
1251 # Returns
1252 # bib id on succes
1253 # event textcode on failure
1254 sub create_copy {
1255     check_session_time();
1256     my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
1257
1258     my $e = new_editor( authtoken => $session{authtoken} );
1259     return $e->event->{textcode} unless ( $e->checkauth );
1260
1261     my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1262     if ( ref($r) eq 'HASH' ) {
1263         return $r->{textcode} . ' ' . $r->{ilsperm};
1264     }
1265
1266     # Check if the barcode exists in asset.copy and bail if it does.
1267     my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1268     if (@$list) {
1269 # in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
1270         $e->finish;
1271         fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1272         die;
1273     }
1274
1275     # Create MARC record
1276     my $record = MARC::Record->new();
1277     $record->encoding('UTF-8');
1278     $record->leader('00881nam a2200193 4500');
1279     my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1280     my @fields = ();
1281     push( @fields, MARC::Field->new( '005', $datespec ) );
1282     push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1283     push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1284     $record->append_fields(@fields);
1285
1286     # Convert the record to XML
1287     my $xml = convert2marcxml($record);
1288
1289     my $bre =
1290       OpenSRF::AppSession->create('open-ils.cat')
1291       ->request( 'open-ils.cat.biblio.record.xml.import',
1292         $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1293     return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1294
1295     # Create volume record
1296     my $vol =
1297       OpenSRF::AppSession->create('open-ils.cat')
1298       ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, $conf->{volume}->{owning_lib} )
1299       ->gather(1);
1300     return $vol->{textcode} if ( $vol->{textcode} );
1301
1302     # Retrieve the user
1303     my $user = get_session;
1304
1305     # Create copy record
1306     my $copy = Fieldmapper::asset::copy->new();
1307     # XXX CUSTOMIZATION NEEDED XXX
1308     # You will need to either create a circ mod for every expected medium type,
1309     # OR you should create a single circ mod for all requests from the external
1310     # system.
1311     # Adjust these lines as needed.
1312     #    $copy->circ_modifier(qq($medium_type)); # XXX CUSTOMIZATION NEEDED XXX
1313     # OR
1314     $copy->circ_modifier($conf->{copy}->{circ_modifier});
1315     $copy->barcode($barcode);
1316     $copy->call_number( $vol->{acn_id} );
1317     $copy->circ_lib($conf->{copy}->{circ_lib});
1318     $copy->circulate('t');
1319     $copy->holdable('t');
1320     $copy->opac_visible('t');
1321     $copy->deleted('f');
1322     $copy->fine_level(2);
1323     $copy->loan_duration(2);
1324     $copy->location($conf->{copy}->{location});
1325     $copy->status($copy_status_id);
1326     $copy->editor('1');
1327     $copy->creator('1');
1328
1329     # Add the configured stat cat entries.
1330     #my @stat_cats;
1331     #my $nodes = $xpath->find("/copy/stat_cat_entry");
1332     #foreach my $node ($nodes->get_nodelist) {
1333     #    next unless ($node->isa('XML::XPath::Node::Element'));
1334     #    my $stat_cat_id = $node->getAttribute('stat_cat');
1335     #    my $value = $node->string_value();
1336     #    # Need to search for an existing asset.stat_cat_entry
1337     #        my $asce = $e->search_asset_stat_cat_entry({'stat_cat' => $stat_cat_id, 'value' => $value})->[0];
1338     #    unless ($asce) {
1339     #        # if not, create a new one and use its id.
1340     #        $asce = Fieldmapper::asset::stat_cat_entry->new();
1341     #        $asce->stat_cat($stat_cat_id);
1342     #        $asce->value($value);
1343     #        $asce->owner($ou->id);
1344     #        $e->xact_begin;
1345     #        $asce = $e->create_asset_stat_cat_entry($asce);
1346     #        $e->xact_commit;
1347     #    }
1348     #    push(@stat_cats, $asce);
1349     #}
1350
1351     $e->xact_begin;
1352     $copy = $e->create_asset_copy($copy);
1353
1354     #if (scalar @stat_cats) {
1355     #    foreach my $asce (@stat_cats) {
1356     #        my $ascecm = Fieldmapper::asset::stat_cat_entry_copy_map->new();
1357     #        $ascecm->stat_cat($asce->stat_cat);
1358     #        $ascecm->stat_cat_entry($asce->id);
1359     #        $ascecm->owning_copy($copy->id);
1360     #        $ascecm = $e->create_asset_stat_cat_entry_copy_map($ascecm);
1361     #    }
1362     #}
1363     $e->commit;
1364     return $e->event->{textcode} unless ($r);
1365     return 'SUCCESS';
1366 }
1367
1368 # Checkout a copy to a patron
1369 #
1370 # Arguments
1371 # copy barcode
1372 # patron barcode
1373 #
1374 # Returns
1375 # textcode of the OSRF response.
1376 sub checkout {
1377     check_session_time();
1378     my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1379
1380     # Check for copy:
1381     my $copy = copy_from_barcode($copy_barcode);
1382     unless ( defined($copy) && blessed($copy) ) {
1383         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1384     }
1385
1386     # Check for user
1387     my $uid = user_id_from_barcode($patron_barcode);
1388     return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1389
1390     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1391         'open-ils.circ.checkout.full.override',
1392         $session{authtoken},
1393         {
1394             copy_barcode => $copy_barcode,
1395             patron_id    => $uid,
1396             due_date     => $due_date
1397         }
1398     )->gather(1);
1399     return $response->{textcode};
1400 }
1401
1402 sub renewal {
1403     check_session_time();
1404     my ( $copy_barcode, $due_date ) = @_;
1405
1406     # Check for copy:
1407     my $copy = copy_from_barcode($copy_barcode);
1408     unless ( defined($copy) && blessed($copy) ) {
1409         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1410     }
1411
1412     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1413         'open-ils.circ.renew.override',
1414         $session{authtoken},
1415         {
1416             copy_barcode => $copy_barcode,
1417             due_date     => $due_date
1418         }
1419     )->gather(1);
1420     return $response->{textcode};
1421 }
1422
1423 # Check a copy in
1424 #
1425 # Arguments
1426 # copy barcode
1427 #
1428 # Returns
1429 # "SUCCESS" on success
1430 # textcode of a failed OSRF request
1431 # 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
1432
1433 sub checkin {
1434     check_session_time();
1435     my ($barcode) = @_;
1436
1437     my $copy = copy_from_barcode($barcode);
1438     return $copy->{textcode} unless ( blessed $copy);
1439
1440     return ("COPY_NOT_CHECKED_OUT $barcode")
1441       unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1442
1443     my $e = new_editor( authtoken => $session{authtoken} );
1444     return $e->event->{textcode} unless ( $e->checkauth );
1445
1446     my $circ = $e->search_action_circulation(
1447         [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1448     my $r =
1449       OpenSRF::AppSession->create('open-ils.circ')
1450       ->request( 'open-ils.circ.checkin.override',
1451         $session{authtoken}, { force => 1, copy_id => $copy->id } )->gather(1);
1452     return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1453     return $r->{textcode};
1454 }
1455
1456 # Get actor.usr.id from barcode.
1457 # Arguments
1458 # patron barcode
1459 #
1460 # Returns
1461 # actor.usr.id
1462 # or hash on error
1463 sub user_id_from_barcode {
1464     check_session_time();
1465     my ($barcode) = @_;
1466
1467     my $response;
1468
1469     my $e = new_editor( authtoken => $session{authtoken} );
1470     return $response unless ( $e->checkauth );
1471
1472     my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1473     return $e->event unless ($card);
1474
1475     $response = $card->[0]->usr if (@$card);
1476
1477     $e->finish;
1478
1479     return $response;
1480 }
1481
1482 # Place a simple hold for a patron.
1483 #
1484 # Arguments
1485 # Target object appropriate for type of hold
1486 # Patron for whom the hold is place
1487 #
1488 # Returns
1489 # "SUCCESS" on success
1490 # textcode of a failed OSRF request
1491 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1492 # (Currently only support 'T' and 'C')
1493
1494 # simple hold should be removed and full holds sub should be used instead - pragmatic solution only
1495
1496 sub place_simple_hold {
1497     check_session_time();
1498
1499     #my ($type, $target, $patron, $pickup_ou) = @_;
1500     my ( $target, $patron_id ) = @_;
1501
1502     require $conf->{path}->{oils_header};
1503     use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1504
1505     osrf_connect( $conf->{path}->{opensrf_core} );
1506     oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
1507     my $ahr = Fieldmapper::action::hold_request->new();
1508     $ahr->hold_type('C');
1509     # 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.
1510     $ahr->target($target);
1511     $ahr->usr($patron_id);
1512     $ahr->requestor($conf->{hold}->{requestor});
1513     # NOTE: When User Agency, we don't know the pickup location until ItemShipped time
1514     # TODO: When Item Agency and using holds, set this to requested copy's circ lib?
1515     $ahr->pickup_lib($conf->{hold}->{init_pickup_lib});
1516     $ahr->phone_notify(''); # TODO: set this based on usr prefs
1517     $ahr->email_notify(1); # TODO: set this based on usr prefs
1518     $ahr->frozen('t');
1519     my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1520     my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1521     $ahr = $e->retrieve_action_hold_request($resp);    # refresh from db
1522     $ahr->frozen('f');
1523     $e->update_action_hold_request($ahr);
1524     $e->commit;
1525     $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
1526
1527     #oils_event_die($resp);
1528     my $errors = "";
1529     if ( ref($resp) eq 'ARRAY' ) {
1530         ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1531         return $errors;
1532     } elsif ( ref($resp) ne 'HASH' ) {
1533         return "Hold placed! hold_id = " . $resp . "\n";
1534     }
1535 }
1536
1537 # Place a hold for a patron.
1538 #
1539 # Arguments
1540 # Type of hold
1541 # Target object appropriate for type of hold
1542 # Patron for whom the hold is place
1543 # OU where hold is to be picked up
1544 #
1545 # Returns
1546 # "SUCCESS" on success
1547 # textcode of a failed OSRF request
1548 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1549 # (Currently only support 'T' and 'C')
1550 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1551 #sub place_hold {
1552 #    check_session_time();
1553 #    my ( $type, $target, $patron, $pickup_ou ) = @_;
1554 #
1555 #    my $ou  = org_unit_from_shortname($work_ou);        # $work_ou is global
1556 #    my $ahr = Fieldmapper::action::hold_request->new;
1557 #    $ahr->hold_type($type);
1558 #    if ( $type eq 'C' ) {
1559 #
1560 #        # Check if we own the copy.
1561 #        if ( $ou->id == $target->circ_lib ) {
1562 #
1563 #            # We own it, so let's place a copy hold.
1564 #            $ahr->target( $target->id );
1565 #            $ahr->current_copy( $target->id );
1566 #        } else {
1567 #
1568 #            # We don't own it, so let's place a title hold instead.
1569 #            my $bib = bre_from_barcode( $target->barcode );
1570 #            $ahr->target( $bib->id );
1571 #            $ahr->hold_type('T');
1572 #        }
1573 #    } elsif ( $type eq 'T' ) {
1574 #        $ahr->target($target);
1575 #    } else {
1576 #        return "HOLD_TYPE_NOT_SUPPORTED";
1577 #    }
1578 #    $ahr->usr( user_id_from_barcode($id) );
1579 #
1580 #    #$ahr->pickup_lib($pickup_ou->id);
1581 #    $ahr->pickup_lib('3');
1582 #    if ( !$patron->email ) {
1583 #        $ahr->email_notify('f');
1584 #        $ahr->phone_notify( $patron->day_phone ) if ( $patron->day_phone );
1585 #    } else {
1586 #        $ahr->email_notify('t');
1587 #    }
1588 #
1589 #    # We must have a title hold and we want to change the hold
1590 #    # expiration date if we're sending the copy to the VC.
1591 #    set_title_hold_expiration($ahr) if ( $ahr->pickup_lib == $ou->id );
1592 #
1593 #    my $params = {
1594 #        pickup_lib => $ahr->pickup_lib,
1595 #        patronid   => $ahr->usr,
1596 #        hold_type  => $ahr->hold_type
1597 #    };
1598 #
1599 #    if ( $ahr->hold_type eq 'C' ) {
1600 #        $params->{copy_id} = $ahr->target;
1601 #    } else {
1602 #        $params->{titleid} = $ahr->target;
1603 #    }
1604 #
1605 #    my $r =
1606 #      OpenSRF::AppSession->create('open-ils.circ')
1607 #      ->request( 'open-ils.circ.title_hold.is_possible',
1608 #        $session{authtoken}, $params )->gather(1);
1609 #
1610 #    if ( $r->{textcode} ) {
1611 #        return $r->{textcode};
1612 #    } elsif ( $r->{success} ) {
1613 #        $r =
1614 #          OpenSRF::AppSession->create('open-ils.circ')
1615 #          ->request( 'open-ils.circ.holds.create.override',
1616 #            $session{authtoken}, $ahr )->gather(1);
1617 #
1618 #        my $returnValue = "SUCCESS";
1619 #        if ( ref($r) eq 'HASH' ) {
1620 #            $returnValue =
1621 #              ( $r->{textcode} eq 'PERM_FAILURE' )
1622 #              ? $r->{ilsperm}
1623 #              : $r->{textcode};
1624 #            $returnValue =~ s/\.override$//
1625 #              if ( $r->{textcode} eq 'PERM_FAILURE' );
1626 #        }
1627 #        return $returnValue;
1628 #    } else {
1629 #        return 'HOLD_NOT_POSSIBLE';
1630 #    }
1631 #}
1632
1633 # Set the expiration date on title holds
1634 #
1635 # Argument
1636 # Fieldmapper action.hold_request object
1637 #
1638 # Returns
1639 # Nothing
1640 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1641 #sub set_title_hold_expiration {
1642 #    my $hold = shift;
1643 #    if ( $title_holds->{unit} && $title_holds->{duration} ) {
1644 #        my $expiration = DateTime->now( time_zone => $tz );
1645 #        $expiration->add( $title_holds->{unit} => $title_holds->{duration} );
1646 #        $hold->expire_time( $expiration->iso8601() );
1647 #    }
1648 #}
1649
1650 # Get actor.org_unit from the shortname
1651 #
1652 # Arguments
1653 # org_unit shortname
1654 #
1655 # Returns
1656 # Fieldmapper aou object
1657 # or HASH on error
1658 sub org_unit_from_shortname {
1659     check_session_time();
1660     my ($shortname) = @_;
1661     my $ou =
1662       OpenSRF::AppSession->create('open-ils.actor')
1663       ->request( 'open-ils.actor.org_unit.retrieve_by_shortname', $shortname )
1664       ->gather(1);
1665     return $ou;
1666 }
1667
1668 # Flesh user information
1669 # Arguments
1670 # actor.usr.id
1671 #
1672 # Returns
1673 # fieldmapped, fleshed user or
1674 # event hash on error
1675 sub flesh_user {
1676     check_session_time();
1677     my ($id) = @_;
1678     my $response =
1679       OpenSRF::AppSession->create('open-ils.actor')
1680       ->request( 'open-ils.actor.user.fleshed.retrieve',
1681         $session{'authtoken'}, $id,
1682         [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1683       ->gather(1);
1684     return $response;
1685 }