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