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