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