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