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