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