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