Begin to break config out into ini file
[sitka/iNCIPit.git] / iNCIPit.cgi
1 #! /usr/bin/perl 
2
3 # This file is part of iNCIPit
4 #
5 # iNCIPit is free software: you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation, either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # iNCIPit is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
13 # License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with iNCIPit. If not, see <http://www.gnu.org/licenses/>.
17
18 use warnings;
19 use strict;
20 use XML::LibXML;
21 use CGI::XMLPost;
22 use HTML::Entities;
23 use CGI::Carp;
24 use XML::XPath;
25 use OpenSRF::System;
26 use OpenSRF::Utils::SettingsClient;
27 use Digest::MD5 qw/md5_hex/;
28 use OpenILS::Utils::Fieldmapper;
29 use OpenILS::Utils::CStoreEditor qw/:funcs/;
30 use OpenILS::Const qw/:const/;
31 use Scalar::Util qw(reftype blessed);
32 use MARC::Record;
33 use MARC::Field;
34 use MARC::File::XML;
35 use POSIX qw/strftime/;
36 use DateTime;
37 use Config::Tiny;
38
39 my $U = "OpenILS::Application::AppUtils";
40
41 my $conf = load_config( 'iNCIPit.ini' );
42
43 my $xmlpost = CGI::XMLPost->new();
44 my $xml     = $xmlpost->data();
45
46 # log posted data
47 # XXX: posted ncip message log filename should be in config.
48 open POST_DATA, ">>post_data.txt";
49 print POST_DATA $xml;
50 close POST_DATA;
51
52 # initialize the parser
53 my $parser = new XML::LibXML;
54 my $doc = $parser->load_xml( string => $xml );
55
56 my %session = login();
57
58 # Setup our SIGALRM handler.
59 $SIG{'ALRM'} = \&logout;
60
61 if ( defined( $session{authtoken} ) ) {
62     $doc->exists('/NCIPMessage/LookupUser')           ? lookupUser()       : (
63     $doc->exists('/NCIPMessage/ItemRequested')        ? item_request()     : (
64     $doc->exists('/NCIPMessage/ItemShipped')          ? item_shipped()     : (
65     $doc->exists('/NCIPMessage/ItemCheckedOut')       ? item_checked_out() : (
66     $doc->exists('/NCIPMessage/CheckOutItem')         ? check_out_item()   : (
67     $doc->exists('/NCIPMessage/ItemCheckedIn')        ? item_checked_in()  : (
68     $doc->exists('/NCIPMessage/CheckInItem')          ? check_in_item()    : (
69     $doc->exists('/NCIPMessage/ItemReceived')         ? item_received()    : (
70     $doc->exists('/NCIPMessage/AcceptItem')           ? accept_item()      : (
71     $doc->exists('/NCIPMessage/ItemRequestCancelled') ? item_cancelled()   : (
72     $doc->exists('/NCIPMessage/ItemRenewed')          ? item_renew()       : (
73     $doc->exists('/NCIPMessage/RenewItem')            ? renew_item()       :
74     fail("UNKNOWN NCIPMessage")
75     )))))))))));
76
77     # Clear any SIGALRM timers.
78     alarm(0);
79     logout();
80 } else {
81     fail("Unable to perform action : Unknown Service Request");
82 }
83
84 # load and parse config file
85 sub load_config {
86     my $file = shift;
87
88     my $Config = Config::Tiny->new;
89     $Config = Config::Tiny->read( $file ) ||
90         die( "Error reading config file ", $file, ": ", Config::Tiny->errstr, "\n" );
91     return $Config;
92 }
93
94 sub logit {
95     my ( $msg, $func, $more_info ) = @_;
96     open RESP_DATA, ">>resp_data.txt";
97     print RESP_DATA $msg;
98     print RESP_DATA $more_info unless !$more_info;
99     close RESP_DATA;
100     print $msg || fail($func);
101 }
102
103 sub staff_log {
104     my ( $taiv, $faiv, $more_info ) = @_;
105     my $now = localtime();
106     open STAFF_LOG, ">>staff_data.csv";
107     print STAFF_LOG "$now, $faiv, $taiv, $more_info\n";
108     close STAFF_LOG;
109 }
110
111 sub item_renew {
112     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
113     my $faidScheme = HTML::Entities::encode($faidSchemeX);
114     my $faidValue  = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
115     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
116     my $taidScheme = HTML::Entities::encode($taidSchemeX);
117     my $taidValue  = $doc->find('/NCIPMessage/ItemRenewed/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
118
119     my $pid = $doc->findvalue('/NCIPMessage/ItemRenewed/UniqueUserId/UserIdentifierValue');
120     my $visid = $doc->findvalue('/NCIPMessage/ItemRenewed/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
121     my $due_date = $doc->findvalue('/NCIPMessage/ItemRenewed/DateDue');
122
123     my $r = renewal( $visid, $due_date );
124
125     my $hd = <<ITEMRENEWAL;
126 Content-type: text/xml
127
128
129 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
130 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
131     <ItemRenewedResponse>
132         <ResponseHeader>
133             <FromAgencyId>
134                 <UniqueAgencyId>
135                     <Scheme>$faidScheme</Scheme>
136                     <Value>$faidValue</Value>
137                 </UniqueAgencyId>
138             </FromAgencyId>
139             <ToAgencyId>
140                 <UniqueAgencyId>
141                     <Scheme>$taidScheme</Scheme>
142                     <Value>$taidValue</Value>
143                 </UniqueAgencyId>
144             </ToAgencyId>
145         </ResponseHeader>
146         <UniqueItemId>
147             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
148         </UniqueItemId>
149     </ItemRenewedResponse>
150 </NCIPMessage> 
151
152 ITEMRENEWAL
153
154     my $more_info = <<MOREINFO;
155
156 VISID             = $visid
157 Desired Due Date     = $due_date
158
159 MOREINFO
160
161     logit( $hd, ( caller(0) )[3], $more_info );
162     staff_log( $taidValue, $faidValue,
163             "ItemRenewal -> Patronid : "
164           . $pid
165           . " | Visid : "
166           . $visid
167           . " | Due Date : "
168           . $due_date );
169 }
170
171 sub renew_item {
172     my $faidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
173     my $faidScheme = HTML::Entities::encode($faidSchemeX);
174     my $faidValue  = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
175     my $taidSchemeX = $doc->findvalue('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
176     my $taidScheme = HTML::Entities::encode($taidSchemeX);
177     my $taidValue  = $doc->find('/NCIPMessage/RenewItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
178
179     my $pid = $doc->findvalue('/NCIPMessage/RenewItem/UniqueUserId/UserIdentifierValue');
180     my $unique_item_id = $doc->findvalue('/NCIPMessage/RenewItem/UniqueItemId/ItemIdentifierValue');
181     my $due_date = $doc->findvalue('/NCIPMessage/RenewItem/DateDue');
182
183     # we are using the UniqueItemId value as a barcode here
184     my $r = renewal( $unique_item_id, $due_date );
185
186     my $hd = <<ITEMRENEWAL;
187 Content-type: text/xml
188
189
190 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
191 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
192     <RenewItemResponse>
193         <ResponseHeader>
194             <FromAgencyId>
195                 <UniqueAgencyId>
196                     <Scheme>$faidScheme</Scheme>
197                     <Value>$faidValue</Value>
198                 </UniqueAgencyId>
199             </FromAgencyId>
200             <ToAgencyId>
201                 <UniqueAgencyId>
202                     <Scheme>$taidScheme</Scheme>
203                     <Value>$taidValue</Value>
204                 </UniqueAgencyId>
205             </ToAgencyId>
206         </ResponseHeader>
207         <UniqueItemId>
208             <ItemIdentifierValue datatype="string">$unique_item_id</ItemIdentifierValue>
209         </UniqueItemId>
210     </RenewItemResponse>
211 </NCIPMessage> 
212
213 ITEMRENEWAL
214
215     my $more_info = <<MOREINFO;
216
217 UNIQUEID             = $unique_item_id
218 Desired Due Date     = $due_date
219
220 MOREINFO
221
222     logit( $hd, ( caller(0) )[3], $more_info );
223     staff_log( $taidValue, $faidValue,
224             "RenewItem -> Patronid : "
225           . $pid
226           . " | Uniqueid: : "
227           . $unique_item_id
228           . " | Due Date : "
229           . $due_date );
230 }
231
232 sub accept_item {
233     my $faidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
234     my $faidScheme = HTML::Entities::encode($faidSchemeX);
235     my $faidValue  = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
236     my $taidSchemeX = $doc->findvalue('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
237     my $taidScheme = HTML::Entities::encode($taidSchemeX);
238     my $taidValue  = $doc->find('/NCIPMessage/AcceptItem/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
239     my $visid = $doc->findvalue('/NCIPMessage/AcceptItem/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
240     my $request_id = $doc->findvalue('/NCIPMessage/AcceptItem/UniqueRequestId/RequestIdentifierValue') || "unknown";
241     my $patron = $doc->findvalue('/NCIPMessage/AcceptItem/UserOptionalFields/VisibleUserId/VisibleUserIdentifier');
242     my $copy = copy_from_barcode($visid);
243     my $r2 = update_copy( $copy, 111 ); # XXX CUSTOMIZATION NEEDED XXX # put into INN-Reach Hold status
244
245 # 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
246
247     my $hd = <<ACCEPTITEM;
248 Content-type: text/xml
249
250
251 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
252 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
253     <AcceptItemResponse>
254         <ResponseHeader>
255             <FromAgencyId>
256                 <UniqueAgencyId>
257                     <Scheme>$faidScheme</Scheme>
258                     <Value>$faidValue</Value>
259                 </UniqueAgencyId>
260             </FromAgencyId>
261             <ToAgencyId>
262                 <UniqueAgencyId>
263                     <Scheme>$taidScheme</Scheme>
264                     <Value>$taidValue</Value>
265                 </UniqueAgencyId>
266             </ToAgencyId>
267         </ResponseHeader>
268     <UniqueRequestId>
269             <ItemIdentifierValue datatype="string">$request_id</ItemIdentifierValue>
270         </UniqueRequestId>
271         <UniqueItemId>
272             <ItemIdentifierValue datatype="string">$visid</ItemIdentifierValue>
273         </UniqueItemId>
274     </AcceptItemResponse>
275 </NCIPMessage> 
276
277 ACCEPTITEM
278
279     logit( $hd, ( caller(0) )[3] );
280     staff_log( $taidValue, $faidValue,
281         "AcceptItem -> Request Id : " . $request_id . " | Patron Id : " . $patron . " | Visible Id :" . $visid );
282 }
283
284 sub item_received {
285     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
286     my $faidScheme = HTML::Entities::encode($faidSchemeX);
287     my $faidValue = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
288     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
289     my $taidScheme = HTML::Entities::encode($taidSchemeX);
290     my $taidValue  = $doc->find('/NCIPMessage/ItemReceived/InitiationHeader/ToAgencyId/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     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
928     staff_log( '', '',
929         ( ( caller(0) )[3] . " -> " . $error_msg ) );
930     die;
931 }
932
933 sub do_lookup_user_error_stanza {
934
935     # XXX: we should include FromAgencyId and ToAgencyId values, but they are not available to the code at this point
936     my $error = shift;
937     my $hd    = <<LOOKUPPROB;
938 Content-type: text/xml
939
940
941 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
942 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
943     <LookupUserResponse>
944         <ResponseHeader>
945             <FromAgencyId>
946                 <UniqueAgencyId>
947                     <Scheme></Scheme>
948                     <Value></Value>
949                 </UniqueAgencyId>
950             </FromAgencyId>
951             <ToAgencyId>
952                 <UniqueAgencyId>
953                     <Scheme></Scheme>
954                     <Value></Value>
955                 </UniqueAgencyId>
956             </ToAgencyId>
957         </ResponseHeader>
958         <Problem>
959             <ProcessingError>
960                 <ProcessingErrorType>
961                     <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
962                     <Value>$error</Value>
963                 </ProcessingErrorType>
964                 <ProcessingErrorElement>
965                     <ElementName>AuthenticationInput</ElementName>
966                 </ProcessingErrorElement>
967             </ProcessingError>
968         </Problem>
969     </LookupUserResponse>
970 </NCIPMessage>
971
972 LOOKUPPROB
973
974     logit( $hd, ( caller(0) )[3] );
975     # XXX: we should log FromAgencyId and ToAgencyId values here, but they are not available to the code at this point
976     staff_log( '', '', ( ( caller(0) )[3] . " -> " . $error ) );
977     die;
978 }
979
980 # Login to the OpenSRF system/Evergreen.
981 #
982 # Returns a hash with the authtoken, authtime, and expiration (time in
983 # seconds since 1/1/1970).
984 sub login {
985
986  # XXX: local opensrf core conf filename should be in config.
987  # XXX: STAFF account with ncip service related permissions should be in config.
988     my $bootstrap = '/openils/conf/opensrf_core.xml';
989     my $uname     = $conf->{auth}->{username};
990     my $password  = $conf->{auth}->{password};
991
992     # Bootstrap the client
993     OpenSRF::System->bootstrap_client( config_file => $bootstrap );
994     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
995     Fieldmapper->import( IDL => $idl );
996
997     # Initialize CStoreEditor:
998     OpenILS::Utils::CStoreEditor->init;
999
1000     my $seed = OpenSRF::AppSession->create('open-ils.auth')
1001       ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1002
1003     return undef unless $seed;
1004
1005     my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1006         'open-ils.auth.authenticate.complete',
1007         {
1008             username => $uname,
1009             password => md5_hex( $seed . md5_hex($password) ),
1010             type     => 'staff'
1011         }
1012     )->gather(1);
1013
1014     return undef unless $response;
1015
1016     my %result;
1017     $result{'authtoken'}  = $response->{payload}->{authtoken};
1018     $result{'authtime'}   = $response->{payload}->{authtime};
1019     $result{'expiration'} = time() + $result{'authtime'}
1020       if ( defined( $result{'authtime'} ) );
1021     return %result;
1022 }
1023
1024 # Check the time versus the session expiration time and login again if
1025 # the session has expired, consequently resetting the session
1026 # paramters. We want to run this before doing anything that requires
1027 # us to have a current session in OpenSRF.
1028 #
1029 # Arguments
1030 # none
1031 #
1032 # Returns
1033 # Nothing
1034 sub check_session_time {
1035     if ( time() > $session{'expiration'} ) {
1036         %session = login();
1037         if ( !%session ) {
1038             die("Failed to reinitialize the session after expiration.");
1039         }
1040     }
1041 }
1042
1043 # Retrieve the logged in user.
1044 #
1045 sub get_session {
1046     my $response =
1047       OpenSRF::AppSession->create('open-ils.auth')
1048       ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1049       ->gather(1);
1050     return $response;
1051 }
1052
1053 # Logout/destroy the OpenSRF session
1054 #
1055 # Argument is
1056 # none
1057 #
1058 # Returns
1059 # Does not return anything
1060 sub logout {
1061     if ( time() < $session{'expiration'} ) {
1062         my $response =
1063           OpenSRF::AppSession->create('open-ils.auth')
1064           ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1065           ->gather(1);
1066         if ($response) {
1067
1068             # strong.silent.success
1069             exit(0);
1070         } else {
1071             fail("Logout unsuccessful. Good-bye, anyway.");
1072         }
1073     }
1074 }
1075
1076 sub update_copy {
1077     check_session_time();
1078     my ( $copy, $status_id ) = @_;
1079     my $e = new_editor( authtoken => $session{authtoken} );
1080     return $e->event->{textcode} unless ( $e->checkauth );
1081     $e->xact_begin;
1082     $copy->status($status_id);
1083     return $e->event unless $e->update_asset_copy($copy);
1084     $e->commit;
1085     return 'SUCCESS';
1086 }
1087
1088 # my paranoia re barcode on shipped items using visid for unique value
1089 sub update_copy_shipped {
1090     check_session_time();
1091     my ( $copy, $status_id, $barcode ) = @_;
1092     my $e = new_editor( authtoken => $session{authtoken} );
1093     return $e->event->{textcode} unless ( $e->checkauth );
1094     $e->xact_begin;
1095     $copy->status($status_id);
1096     $copy->barcode($barcode);
1097     return $e->event unless $e->update_asset_copy($copy);
1098     $e->commit;
1099     return 'SUCCESS';
1100 }
1101
1102 # Delete a copy
1103 #
1104 # Argument
1105 # Fieldmapper asset.copy object
1106 #
1107 # Returns
1108 # "SUCCESS" on success
1109 # Event textcode if an error occurs
1110 sub delete_copy {
1111     check_session_time();
1112     my ($copy) = @_;
1113
1114     my $e = new_editor( authtoken => $session{authtoken} );
1115     return $e->event->{textcode} unless ( $e->checkauth );
1116
1117     # Get the calnumber
1118     my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1119     return $e->event->{textcode} unless ($vol);
1120
1121     # Get the biblio.record_entry
1122     my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1123     return $e->event->{textcode} unless ($bre);
1124
1125     # Delete everything in a transaction and rollback if anything fails.
1126     # TODO: I think there is a utility function which handles all this
1127     $e->xact_begin;
1128     my $r;    # To hold results of editor calls
1129     $r = $e->delete_asset_copy($copy);
1130     unless ($r) {
1131         my $lval = $e->event->{textcode};
1132         $e->rollback;
1133         return $lval;
1134     }
1135     my $list =
1136       $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1137     unless (@$list) {
1138         $r = $e->delete_asset_call_number($vol);
1139         unless ($r) {
1140             my $lval = $e->event->{textcode};
1141             $e->rollback;
1142             return $lval;
1143         }
1144         $list = $e->search_asset_call_number( { record => $bre->id, deleted => 'f' } );
1145         unless (@$list) {
1146             $r = $e->delete_biblio_record_entry($bre);
1147             unless ($r) {
1148                 my $lval = $e->event->{textcode};
1149                 $e->rollback;
1150                 return $lval;
1151             }
1152         }
1153     }
1154     $e->commit;
1155     return 'SUCCESS';
1156 }
1157
1158 # Get asset.copy from asset.copy.barcode.
1159 # Arguments
1160 # copy barcode
1161 #
1162 # Returns
1163 # asset.copy fieldmaper object
1164 # or hash on error
1165 sub copy_from_barcode {
1166     check_session_time();
1167     my ($barcode) = @_;
1168     my $response =
1169       OpenSRF::AppSession->create('open-ils.search')
1170       ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1171       ->gather(1);
1172     return $response;
1173 }
1174
1175 sub locid_from_barcode {
1176     my ($barcode) = @_;
1177     my $response =
1178       OpenSRF::AppSession->create('open-ils.search')
1179       ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1180       ->gather(1);
1181     return $response->{ids}[0];
1182 }
1183
1184 # Convert a MARC::Record to XML for Evergreen
1185 #
1186 # Copied from Dyrcona's issa framework which copied
1187 # it from MVLC's Safari Load program which copied it
1188 # from some code in the Open-ILS example import scripts.
1189 #
1190 # Argument
1191 # A MARC::Record object
1192 #
1193 # Returns
1194 # String with XML for the MARC::Record as Evergreen likes it
1195 sub convert2marcxml {
1196     my $input = shift;
1197     ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1198     $xml =~ s/^<\?xml.+\?\s*>//go;
1199     $xml =~ s/>\s+</></go;
1200     $xml =~ s/\p{Cc}//go;
1201     $xml = $U->entityize($xml);
1202     $xml =~ s/[\x00-\x1f]//go;
1203     return $xml;
1204 }
1205
1206 # Create a copy and marc record
1207 #
1208 # Arguments
1209 # title
1210 # call number
1211 # copy barcode
1212 #
1213 # Returns
1214 # bib id on succes
1215 # event textcode on failure
1216 sub create_copy {
1217     check_session_time();
1218     my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
1219
1220     my $e = new_editor( authtoken => $session{authtoken} );
1221     return $e->event->{textcode} unless ( $e->checkauth );
1222
1223     my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1224     if ( ref($r) eq 'HASH' ) {
1225         return $r->{textcode} . ' ' . $r->{ilsperm};
1226     }
1227
1228     # Check if the barcode exists in asset.copy and bail if it does.
1229     my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1230     if (@$list) {
1231 # in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
1232         $e->finish;
1233         fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1234         die;
1235     }
1236
1237     # Create MARC record
1238     my $record = MARC::Record->new();
1239     $record->encoding('UTF-8');
1240     $record->leader('00881nam a2200193 4500');
1241     my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1242     my @fields = ();
1243     push( @fields, MARC::Field->new( '005', $datespec ) );
1244     push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1245     push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1246     $record->append_fields(@fields);
1247
1248     # Convert the record to XML
1249     my $xml = convert2marcxml($record);
1250
1251     my $bre =
1252       OpenSRF::AppSession->create('open-ils.cat')
1253       ->request( 'open-ils.cat.biblio.record.xml.import',
1254         $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1255     return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1256
1257     # Create volume record
1258     my $vol =
1259       OpenSRF::AppSession->create('open-ils.cat')
1260       ->request( 'open-ils.cat.call_number.find_or_create', $session{authtoken}, $callnumber, $bre->id, 2 )   # XXX CUSTOMIZATION NEEDED XXX
1261       ->gather(1);
1262     return $vol->{textcode} if ( $vol->{textcode} );
1263
1264     # Retrieve the user
1265     my $user = get_session;
1266
1267     # Create copy record
1268     my $copy = Fieldmapper::asset::copy->new();
1269     # XXX CUSTOMIZATION NEEDED XXX
1270     # You will need to either create a circ mod for every expected medium type,
1271     # OR you should create a single circ mod for all requests from the external
1272     # system.
1273     # Adjust these lines as needed.
1274     #    $copy->circ_modifier(qq($medium_type)); # XXX CUSTOMIZATION NEEDED XXX
1275     # OR
1276     $copy->circ_modifier('DCB'); # XXX CUSTOMIZATION NEEDED XXX
1277     $copy->barcode($barcode);
1278     $copy->call_number( $vol->{acn_id} );
1279     $copy->circ_lib(2); # XXX CUSTOMIZATION NEEDED XXX
1280     $copy->circulate('t');
1281     $copy->holdable('t');
1282     $copy->opac_visible('t');
1283     $copy->deleted('f');
1284     $copy->fine_level(2);
1285     $copy->loan_duration(2);
1286     $copy->location(156); # XXX CUSTOMIZATION NEEDED XXX
1287     $copy->status($copy_status_id);
1288     $copy->editor('1');
1289     $copy->creator('1');
1290
1291     # Add the configured stat cat entries.
1292     #my @stat_cats;
1293     #my $nodes = $xpath->find("/copy/stat_cat_entry");
1294     #foreach my $node ($nodes->get_nodelist) {
1295     #    next unless ($node->isa('XML::XPath::Node::Element'));
1296     #    my $stat_cat_id = $node->getAttribute('stat_cat');
1297     #    my $value = $node->string_value();
1298     #    # Need to search for an existing asset.stat_cat_entry
1299     #        my $asce = $e->search_asset_stat_cat_entry({'stat_cat' => $stat_cat_id, 'value' => $value})->[0];
1300     #    unless ($asce) {
1301     #        # if not, create a new one and use its id.
1302     #        $asce = Fieldmapper::asset::stat_cat_entry->new();
1303     #        $asce->stat_cat($stat_cat_id);
1304     #        $asce->value($value);
1305     #        $asce->owner($ou->id);
1306     #        $e->xact_begin;
1307     #        $asce = $e->create_asset_stat_cat_entry($asce);
1308     #        $e->xact_commit;
1309     #    }
1310     #    push(@stat_cats, $asce);
1311     #}
1312
1313     $e->xact_begin;
1314     $copy = $e->create_asset_copy($copy);
1315
1316     #if (scalar @stat_cats) {
1317     #    foreach my $asce (@stat_cats) {
1318     #        my $ascecm = Fieldmapper::asset::stat_cat_entry_copy_map->new();
1319     #        $ascecm->stat_cat($asce->stat_cat);
1320     #        $ascecm->stat_cat_entry($asce->id);
1321     #        $ascecm->owning_copy($copy->id);
1322     #        $ascecm = $e->create_asset_stat_cat_entry_copy_map($ascecm);
1323     #    }
1324     #}
1325     $e->commit;
1326     return $e->event->{textcode} unless ($r);
1327     return 'SUCCESS';
1328 }
1329
1330 # Checkout a copy to a patron
1331 #
1332 # Arguments
1333 # copy barcode
1334 # patron barcode
1335 #
1336 # Returns
1337 # textcode of the OSRF response.
1338 sub checkout {
1339     check_session_time();
1340     my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1341
1342     # Check for copy:
1343     my $copy = copy_from_barcode($copy_barcode);
1344     unless ( defined($copy) && blessed($copy) ) {
1345         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1346     }
1347
1348     # Check for user
1349     my $uid = user_id_from_barcode($patron_barcode);
1350     return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1351
1352     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1353         'open-ils.circ.checkout.full.override',
1354         $session{authtoken},
1355         {
1356             copy_barcode => $copy_barcode,
1357             patron_id    => $uid,
1358             due_date     => $due_date
1359         }
1360     )->gather(1);
1361     return $response->{textcode};
1362 }
1363
1364 sub renewal {
1365     check_session_time();
1366     my ( $copy_barcode, $due_date ) = @_;
1367
1368     # Check for copy:
1369     my $copy = copy_from_barcode($copy_barcode);
1370     unless ( defined($copy) && blessed($copy) ) {
1371         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1372     }
1373
1374     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1375         'open-ils.circ.renew.override',
1376         $session{authtoken},
1377         {
1378             copy_barcode => $copy_barcode,
1379             due_date     => $due_date
1380         }
1381     )->gather(1);
1382     return $response->{textcode};
1383 }
1384
1385 # Check a copy in
1386 #
1387 # Arguments
1388 # copy barcode
1389 #
1390 # Returns
1391 # "SUCCESS" on success
1392 # textcode of a failed OSRF request
1393 # 'COPY_NOT_CHECKED_OUT' when the copy is not checked out
1394
1395 sub checkin {
1396     check_session_time();
1397     my ($barcode) = @_;
1398
1399     my $copy = copy_from_barcode($barcode);
1400     return $copy->{textcode} unless ( blessed $copy);
1401
1402     return ("COPY_NOT_CHECKED_OUT $barcode")
1403       unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1404
1405     my $e = new_editor( authtoken => $session{authtoken} );
1406     return $e->event->{textcode} unless ( $e->checkauth );
1407
1408     my $circ = $e->search_action_circulation(
1409         [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1410     my $r =
1411       OpenSRF::AppSession->create('open-ils.circ')
1412       ->request( 'open-ils.circ.checkin.override',
1413         $session{authtoken}, { force => 1, copy_id => $copy->id } )->gather(1);
1414     return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1415     return $r->{textcode};
1416 }
1417
1418 # Get actor.usr.id from barcode.
1419 # Arguments
1420 # patron barcode
1421 #
1422 # Returns
1423 # actor.usr.id
1424 # or hash on error
1425 sub user_id_from_barcode {
1426     check_session_time();
1427     my ($barcode) = @_;
1428
1429     my $response;
1430
1431     my $e = new_editor( authtoken => $session{authtoken} );
1432     return $response unless ( $e->checkauth );
1433
1434     my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1435     return $e->event unless ($card);
1436
1437     $response = $card->[0]->usr if (@$card);
1438
1439     $e->finish;
1440
1441     return $response;
1442 }
1443
1444 # Place a simple hold for a patron.
1445 #
1446 # Arguments
1447 # Target object appropriate for type of hold
1448 # Patron for whom the hold is place
1449 #
1450 # Returns
1451 # "SUCCESS" on success
1452 # textcode of a failed OSRF request
1453 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1454 # (Currently only support 'T' and 'C')
1455
1456 # simple hold should be removed and full holds sub should be used instead - pragmatic solution only
1457
1458 sub place_simple_hold {
1459     check_session_time();
1460
1461     #my ($type, $target, $patron, $pickup_ou) = @_;
1462     my ( $target, $patron_id ) = @_;
1463
1464     # NOTE : switch "t" to an "f" to make inactive hold active
1465     require '/openils/bin/oils_header.pl';    # XXX CUSTOMIZATION NEEDED XXX
1466     use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1467
1468  # XXX: local opensrf core conf filename should be in config.
1469  # XXX: STAFF account with ncip service related permissions should be in config.
1470     osrf_connect("/openils/conf/opensrf_core.xml");
1471     oils_login( $conf->{auth}->{username}, $conf->{auth}->{password} );
1472     my $ahr = Fieldmapper::action::hold_request->new();
1473     $ahr->hold_type('C');
1474     # 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.
1475     $ahr->target($target);
1476     $ahr->usr($patron_id);
1477     $ahr->requestor(1);     # XXX CUSTOMIZATION NEEDED XXX admin user (?)
1478     $ahr->pickup_lib(2);    # XXX CUSTOMIZATION NEEDED XXX script user OU
1479     $ahr->phone_notify('');
1480     $ahr->email_notify(1);
1481     $ahr->frozen('t');
1482     my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1483     my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1484     $ahr = $e->retrieve_action_hold_request($resp);    # refresh from db
1485     $ahr->frozen('f');
1486     $e->update_action_hold_request($ahr);
1487     $e->commit;
1488     $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
1489
1490     #oils_event_die($resp);
1491     my $errors = "";
1492     if ( ref($resp) eq 'ARRAY' ) {
1493         ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1494         return $errors;
1495     } elsif ( ref($resp) ne 'HASH' ) {
1496         return "Hold placed! hold_id = " . $resp . "\n";
1497     }
1498 }
1499
1500 # Place a hold for a patron.
1501 #
1502 # Arguments
1503 # Type of hold
1504 # Target object appropriate for type of hold
1505 # Patron for whom the hold is place
1506 # OU where hold is to be picked up
1507 #
1508 # Returns
1509 # "SUCCESS" on success
1510 # textcode of a failed OSRF request
1511 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1512 # (Currently only support 'T' and 'C')
1513 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1514 #sub place_hold {
1515 #    check_session_time();
1516 #    my ( $type, $target, $patron, $pickup_ou ) = @_;
1517 #
1518 #    my $ou  = org_unit_from_shortname($work_ou);        # $work_ou is global
1519 #    my $ahr = Fieldmapper::action::hold_request->new;
1520 #    $ahr->hold_type($type);
1521 #    if ( $type eq 'C' ) {
1522 #
1523 #        # Check if we own the copy.
1524 #        if ( $ou->id == $target->circ_lib ) {
1525 #
1526 #            # We own it, so let's place a copy hold.
1527 #            $ahr->target( $target->id );
1528 #            $ahr->current_copy( $target->id );
1529 #        } else {
1530 #
1531 #            # We don't own it, so let's place a title hold instead.
1532 #            my $bib = bre_from_barcode( $target->barcode );
1533 #            $ahr->target( $bib->id );
1534 #            $ahr->hold_type('T');
1535 #        }
1536 #    } elsif ( $type eq 'T' ) {
1537 #        $ahr->target($target);
1538 #    } else {
1539 #        return "HOLD_TYPE_NOT_SUPPORTED";
1540 #    }
1541 #    $ahr->usr( user_id_from_barcode($id) );
1542 #
1543 #    #$ahr->pickup_lib($pickup_ou->id);
1544 #    $ahr->pickup_lib('3');
1545 #    if ( !$patron->email ) {
1546 #        $ahr->email_notify('f');
1547 #        $ahr->phone_notify( $patron->day_phone ) if ( $patron->day_phone );
1548 #    } else {
1549 #        $ahr->email_notify('t');
1550 #    }
1551 #
1552 #    # We must have a title hold and we want to change the hold
1553 #    # expiration date if we're sending the copy to the VC.
1554 #    set_title_hold_expiration($ahr) if ( $ahr->pickup_lib == $ou->id );
1555 #
1556 #    my $params = {
1557 #        pickup_lib => $ahr->pickup_lib,
1558 #        patronid   => $ahr->usr,
1559 #        hold_type  => $ahr->hold_type
1560 #    };
1561 #
1562 #    if ( $ahr->hold_type eq 'C' ) {
1563 #        $params->{copy_id} = $ahr->target;
1564 #    } else {
1565 #        $params->{titleid} = $ahr->target;
1566 #    }
1567 #
1568 #    my $r =
1569 #      OpenSRF::AppSession->create('open-ils.circ')
1570 #      ->request( 'open-ils.circ.title_hold.is_possible',
1571 #        $session{authtoken}, $params )->gather(1);
1572 #
1573 #    if ( $r->{textcode} ) {
1574 #        return $r->{textcode};
1575 #    } elsif ( $r->{success} ) {
1576 #        $r =
1577 #          OpenSRF::AppSession->create('open-ils.circ')
1578 #          ->request( 'open-ils.circ.holds.create.override',
1579 #            $session{authtoken}, $ahr )->gather(1);
1580 #
1581 #        my $returnValue = "SUCCESS";
1582 #        if ( ref($r) eq 'HASH' ) {
1583 #            $returnValue =
1584 #              ( $r->{textcode} eq 'PERM_FAILURE' )
1585 #              ? $r->{ilsperm}
1586 #              : $r->{textcode};
1587 #            $returnValue =~ s/\.override$//
1588 #              if ( $r->{textcode} eq 'PERM_FAILURE' );
1589 #        }
1590 #        return $returnValue;
1591 #    } else {
1592 #        return 'HOLD_NOT_POSSIBLE';
1593 #    }
1594 #}
1595
1596 # Set the expiration date on title holds
1597 #
1598 # Argument
1599 # Fieldmapper action.hold_request object
1600 #
1601 # Returns
1602 # Nothing
1603 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1604 #sub set_title_hold_expiration {
1605 #    my $hold = shift;
1606 #    if ( $title_holds->{unit} && $title_holds->{duration} ) {
1607 #        my $expiration = DateTime->now( time_zone => $tz );
1608 #        $expiration->add( $title_holds->{unit} => $title_holds->{duration} );
1609 #        $hold->expire_time( $expiration->iso8601() );
1610 #    }
1611 #}
1612
1613 # Get actor.org_unit from the shortname
1614 #
1615 # Arguments
1616 # org_unit shortname
1617 #
1618 # Returns
1619 # Fieldmapper aou object
1620 # or HASH on error
1621 sub org_unit_from_shortname {
1622     check_session_time();
1623     my ($shortname) = @_;
1624     my $ou =
1625       OpenSRF::AppSession->create('open-ils.actor')
1626       ->request( 'open-ils.actor.org_unit.retrieve_by_shortname', $shortname )
1627       ->gather(1);
1628     return $ou;
1629 }
1630
1631 # Flesh user information
1632 # Arguments
1633 # actor.usr.id
1634 #
1635 # Returns
1636 # fieldmapped, fleshed user or
1637 # event hash on error
1638 sub flesh_user {
1639     check_session_time();
1640     my ($id) = @_;
1641     my $response =
1642       OpenSRF::AppSession->create('open-ils.actor')
1643       ->request( 'open-ils.actor.user.fleshed.retrieve',
1644         $session{'authtoken'}, $id,
1645         [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1646       ->gather(1);
1647     return $response;
1648 }