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