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