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