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