Clarify item_request(), add missing $U
[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     my $copy = copy_from_barcode($barcode);
575     fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
576     my $r2 = update_copy( $copy, 0 );    # Available now
577
578     my $hd = <<CHECKINITEM;
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     <CheckInItemResponse>
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     </CheckInItemResponse>
603 </NCIPMessage> 
604
605 CHECKINITEM
606
607     logit( $hd, ( caller(0) )[3] );
608     staff_log( $taidValue, $faidValue, "CheckInItem -> Barcode : " . $barcode );
609 }
610
611 sub item_shipped {
612     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
613     my $faidScheme = HTML::Entities::encode($faidSchemeX);
614     my $faidValue  = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
615     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
616     my $taidScheme = HTML::Entities::encode($taidSchemeX);
617     my $taidValue  = $doc->find('/NCIPMessage/ItemShipped/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
618
619     my $visid = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/VisibleItemId/VisibleItemIdentifier') . $faidValue;
620     my $barcode = $doc->findvalue('/NCIPMessage/ItemShipped/UniqueItemId/ItemIdentifierValue') . $faidValue;
621     my $title = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/BibliographicDescription/Title');
622     my $callnumber = $doc->findvalue('/NCIPMessage/ItemShipped/ItemOptionalFields/ItemDescription/CallNumber');
623
624     my $copy = copy_from_barcode($barcode);
625     fail( $copy->{textcode} . " $barcode" ) unless ( blessed $copy);
626     my $r = update_copy_shipped( $copy, 112, $visid )
627       ; # put copy into INN-Reach Transit status & modify barcode = Visid != tempIIIiNumber
628
629     my $hd = <<ITEMSHIPPED;
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     <ItemShippedResponse>
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">$visid</ItemIdentifierValue>
652         </UniqueItemId>
653     </ItemShippedResponse>
654 </NCIPMessage> 
655
656 ITEMSHIPPED
657
658     logit( $hd, ( caller(0) )[3] );
659     staff_log( $taidValue, $faidValue,
660             "ItemShipped -> Visible Id : "
661           . $visid
662           . " | Barcode : "
663           . $barcode
664           . " | Title : "
665           . $title
666           . " | Call Number : "
667           . $callnumber );
668 }
669
670 sub item_request {
671     my $faidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
672     my $faidScheme = HTML::Entities::encode($faidSchemeX);
673     my $faidValue  = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
674
675     my $taidSchemeX = $doc->findvalue('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
676     my $taidScheme = HTML::Entities::encode($taidSchemeX);
677     my $taidValue  = $doc->find('/NCIPMessage/ItemRequested/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
678     my $UniqueItemIdAgencyIdValue = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/UniqueAgencyId/Value');
679
680     my $id = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueUserId/UserIdentifierValue');
681     my $barcode = $doc->findvalue('/NCIPMessage/ItemRequested/UniqueItemId/ItemIdentifierValue');
682     my $author = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Author');
683     my $title = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/Title');
684     my $callnumber = $doc->findvalue('/NCIPMessage/ItemRequested/ItemOptionalFields/ItemDescription/CallNumber');
685     my $medium_type = $doc->find('/NCIPMessage/ItemRequested/ItemOptionalFields/BibliographicDescription/MediumType/Value');
686
687     my $r = "default error checking response";
688
689     if ( $barcode =~ /^i/ ) {    # XXX EG is User Agency # create copy only if barcode is an iNUMBER
690         my $copy_status_id = 110;    # XXX CUSTOMIZATION NEEDED XXX # INN-Reach Loan Requested - local configured status
691         $barcode .= $faidValue;
692         # 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
693         $r = create_copy( $title, $callnumber, $barcode, 0, $medium_type );
694         my $copy = copy_from_barcode($barcode);
695         my $r2   = place_simple_hold( $copy->id, $pid );
696         my $r3   = update_copy( $copy, $copy_status_id );
697     } else {    # XXX EG is Item Agency
698         # place hold for user UniqueUserId/UniqueAgencyId/Value = institution account
699         my $copy = copy_from_barcode($barcode);
700         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
701         $r = place_simple_hold( $copy->id, $pid2 );
702         my $r2 = update_copy( $copy, 111 ); # XXX CUSTOMIZATION NEEDED XXX # put into INN-Reach Hold status
703     }
704
705     my $hd = <<ITEMREQ;
706 Content-type: text/xml
707
708
709 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
710 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
711     <ItemRequestedResponse>
712         <ResponseHeader>
713             <FromAgencyId>
714                 <UniqueAgencyId>
715                     <Scheme>$faidScheme</Scheme>
716                     <Value>$faidValue</Value>
717                 </UniqueAgencyId>
718             </FromAgencyId>
719             <ToAgencyId>
720                 <UniqueAgencyId>
721                     <Scheme>$taidScheme</Scheme>
722                     <Value>$taidValue</Value>
723                 </UniqueAgencyId>
724             </ToAgencyId>
725         </ResponseHeader>
726         <UniqueUserId>
727             <UniqueAgencyId>
728                 <Scheme datatype="string">$taidScheme</Scheme>
729                 <Value datatype="string">$taidValue</Value>
730             </UniqueAgencyId>
731             <UserIdentifierValue datatype="string">$id</UserIdentifierValue>
732         </UniqueUserId>
733         <UniqueItemId>
734             <ItemIdentifierValue datatype="string">$barcode</ItemIdentifierValue>
735         </UniqueItemId>
736         <ItemOptionalFields>
737             <BibliographicDescription>
738         <Author datatype="string">$author</Author>
739         <Title datatype="string">$title</Title>
740             </BibliographicDescription>
741             <ItemDescription>
742                 <CallNumber datatype="string">$callnumber</CallNumber>
743             </ItemDescription>
744        </ItemOptionalFields>
745     </ItemRequestedResponse>
746 </NCIPMessage> 
747
748 ITEMREQ
749
750     logit( $hd, ( caller(0) )[3] );
751     staff_log( $taidValue, $faidValue,
752             "ItemRequested -> Barcode : "
753           . $barcode
754           . " | Title : "
755           . $title
756           . " | Call Number : "
757           . $callnumber
758           . " | ID :"
759           . $id );
760 }
761
762 sub lookupUser {
763
764     my $faidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Scheme');
765     $faidScheme = HTML::Entities::encode($faidScheme);
766     my $faidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/FromAgencyId/UniqueAgencyId/Value');
767     my $taidScheme = $doc->findvalue('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Scheme');
768     $taidScheme = HTML::Entities::encode($taidScheme);
769
770     my $taidValue = $doc->find('/NCIPMessage/LookupUser/InitiationHeader/ToAgencyId/UniqueAgencyId/Value');
771     my $id = $doc->findvalue('/NCIPMessage/LookupUser/VisibleUserId/VisibleUserIdentifier');
772     my $uidValue = user_id_from_barcode($id);
773
774     if ( !defined($uidValue)
775         || ( ref($uidValue) && reftype($uidValue) eq 'HASH' ) )
776     {
777         do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
778         die;
779     }
780
781     my ( $propername, $email, $good_until, $userprivid, $block_stanza ) =
782       ( "name here", "", "good until", "0", "" );    # defaults
783
784     my $patron = flesh_user($uidValue);
785
786     #if (blessed($patron)) {
787     my $patron_ok = 1;
788     my @penalties = @{ $patron->standing_penalties };
789
790     if ( $patron->deleted eq 't' ) {
791         do_lookup_user_error_stanza("PATRON_DELETED : $uidValue");
792         die;
793     } elsif ( $patron->barred eq 't' ) {
794         do_lookup_user_error_stanza("PATRON_BARRED : $uidValue");
795         die;
796     } elsif ( $patron->active eq 'f' ) {
797         do_lookup_user_error_stanza("PATRON_INACTIVE : $uidValue");
798         die;
799     }
800
801     elsif ( $#penalties > -1 ) {
802
803 #                my $penalty;
804 #                   foreach $penalty (@penalties) {
805 #                    if (defined($penalty->standing_penalty->block_list)) {
806 #                            my @block_list = split(/\|/, $penalty->standing_penalty->block_list);
807 #                            foreach my $block (@block_list) {
808 #                                foreach my $block_on (@$block_types) {
809 #                                    if ($block eq $block_on) {
810 #                                        $block_stanza .= "\n".$penalty->standing_penalty->name;
811 #                                        $patron_ok = 0;
812 #                                    }
813 #                                    last unless ($patron_ok);
814 #                            }
815 #                                last unless ($patron_ok);
816 #                          }
817 #                     }
818 #                }
819         $block_stanza = qq(
820             <BlockOrTrap>
821                 <UniqueAgencyId>
822                     <Scheme datatype="string">http://just.testing.now</Scheme>
823                     <Value datatype="string">$faidValue</Value>
824                 </UniqueAgencyId>
825                 <BlockOrTrapType>
826                     <Scheme datatype="string">http://just.testing.now</Scheme>
827                     <Value datatype="string">Block Hold</Value>
828                 </BlockOrTrapType>
829             </BlockOrTrap>);
830     }
831
832     if ( defined( $patron->email ) ) {
833         $email = qq(
834             <UserAddressInformation>
835                 <ElectronicAddress>
836                     <ElectronicAddressType>
837                         <Scheme datatype="string">http://testing.now</Scheme>
838                         <Value datatype="string">mailto</Value>
839                     </ElectronicAddressType>
840                     <ElectronicAddressData datatype="string">)
841           . HTML::Entities::encode( $patron->email )
842           . qq(</ElectronicAddressData>
843                 </ElectronicAddress>
844             </UserAddressInformation>);
845     }
846
847     $propername = $patron->first_given_name . " " . $patron->family_name;
848     $good_until = $patron->expire_date || "unknown";
849     $userprivid = $patron->profile;
850     my $userou   = $patron->home_ou->name;
851     my $userpriv = $patron->profile->name;
852
853     #} else {
854     #    do_lookup_user_error_stanza("PATRON_NOT_FOUND : $id");
855     #    die;
856     #}
857     my $hd = <<LOOKUPUSERRESPONSE;
858 Content-type: text/xml
859
860
861 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
862 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
863     <LookupUserResponse>
864         <ResponseHeader>
865             <FromAgencyId>
866                 <UniqueAgencyId>
867                     <Scheme>$taidScheme</Scheme>
868                     <Value>$taidValue</Value>
869                 </UniqueAgencyId>
870             </FromAgencyId>
871             <ToAgencyId>
872                 <UniqueAgencyId>
873                    <Scheme>$faidScheme</Scheme>
874                    <Value>$faidValue</Value>
875                 </UniqueAgencyId>
876             </ToAgencyId>
877         </ResponseHeader>
878         <UniqueUserId>
879             <UniqueAgencyId>
880                 <Scheme>$taidScheme</Scheme>
881                 <Value>$taidValue</Value>
882             </UniqueAgencyId>
883             <UserIdentifierValue>$id</UserIdentifierValue>
884         </UniqueUserId>
885         <UserOptionalFields>
886             <VisibleUserId>
887                 <VisibleUserIdentifierType>
888                     <Scheme datatype="string">http://blah.com</Scheme>
889                     <Value datatype="string">Barcode</Value>
890                 </VisibleUserIdentifierType>
891                 <VisibleUserIdentifier datatype="string">$id</VisibleUserIdentifier>
892             </VisibleUserId>
893             <NameInformation>
894                 <PersonalNameInformation>
895                     <UnstructuredPersonalUserName datatype="string">$propername</UnstructuredPersonalUserName>
896                 </PersonalNameInformation>
897             </NameInformation>
898             <UserPrivilege>
899                 <UniqueAgencyId>
900                     <Scheme datatype="string">$faidScheme</Scheme>
901                     <Value datatype="string">$faidValue</Value>
902                 </UniqueAgencyId>
903                 <AgencyUserPrivilegeType>
904                     <Scheme datatype="string">http://testing.purposes.only</Scheme>
905                     <Value datatype="string">$userpriv</Value>
906                 </AgencyUserPrivilegeType>
907                 <ValidToDate datatype="string">$good_until</ValidToDate>
908             </UserPrivilege> $email $block_stanza
909         </UserOptionalFields>
910    </LookupUserResponse>
911 </NCIPMessage>
912
913 LOOKUPUSERRESPONSE
914
915     logit( $hd, ( caller(0) )[3] );
916     staff_log( $taidValue, $faidValue,
917             "LookupUser -> Patron Barcode : "
918           . $id
919           . " | Patron Id : "
920           . $uidValue
921           . " | User Name : "
922           . $propername
923           . " | User Priv : "
924           . $userpriv );
925 }
926
927 sub fail {
928     my $error_msg =
929       shift || "THIS IS THE DEFAULT / DO NOT HANG III NCIP RESP MSG";
930     print "Content-type: text/xml\n\n";
931
932     print <<ITEMREQ;
933 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
934 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
935     <ItemRequestedResponse>
936         <ResponseHeader>
937             <FromAgencyId>
938                 <UniqueAgencyId>
939                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
940                     <Value></Value>
941                 </UniqueAgencyId>
942             </FromAgencyId>
943             <ToAgencyId>
944                 <UniqueAgencyId>
945                     <Scheme>http://136.181.125.166:6601/IRCIRCD?target=get_scheme_values&amp;scheme=UniqueAgencyId</Scheme>
946                     <Value>$error_msg</Value>
947                 </UniqueAgencyId>
948             </ToAgencyId>
949         </ResponseHeader>
950     </ItemRequestedResponse>
951 </NCIPMessage>
952
953 ITEMREQ
954
955     staff_log( $taidValue, $faidValue,
956         ( ( caller(0) )[3] . " -> " . $error_msg ) );
957     die;
958 }
959
960 sub do_lookup_user_error_stanza {
961
962     my $error = shift;
963     my $hd    = <<LOOKUPPROB;
964 Content-type: text/xml
965
966
967 <!DOCTYPE NCIPMessage PUBLIC "-//NISO//NCIP DTD Version 1.0//EN" "http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
968 <NCIPMessage version="http://www.niso.org/ncip/v1_0/imp1/dtd/ncip_v1_0.dtd">
969     <LookupUserResponse>
970         <ResponseHeader>
971             <FromAgencyId>
972                 <UniqueAgencyId>
973                     <Scheme>$taidScheme</Scheme>
974                     <Value>$taidValue</Value>
975                 </UniqueAgencyId>
976             </FromAgencyId>
977             <ToAgencyId>
978                 <UniqueAgencyId>
979                     <Scheme>$faidScheme</Scheme>
980                     <Value>$faidValue</Value>
981                 </UniqueAgencyId>
982             </ToAgencyId>
983         </ResponseHeader>
984         <Problem>
985             <ProcessingError>
986                 <ProcessingErrorType>
987                     <Scheme>http://www.niso.org/ncip/v1_0/schemes/processingerrortype/lookupuserprocessingerror.scm</Scheme>
988                     <Value>$error</Value>
989                 </ProcessingErrorType>
990                 <ProcessingErrorElement>
991                     <ElementName>AuthenticationInput</ElementName>
992                 </ProcessingErrorElement>
993             </ProcessingError>
994         </Problem>
995     </LookupUserResponse>
996 </NCIPMessage>
997
998 LOOKUPPROB
999
1000     logit( $hd, ( caller(0) )[3] );
1001     staff_log( $taidValue, $faidValue, ( ( caller(0) )[3] . " -> " . $error ) );
1002     die;
1003 }
1004
1005 # Login to the OpenSRF system/Evergreen.
1006 #
1007 # Returns a hash with the authtoken, authtime, and expiration (time in
1008 # seconds since 1/1/1970).
1009 sub login {
1010
1011  # XXX: local opensrf core conf filename should be in config.
1012  # XXX: STAFF account with ncip service related permissions should be in config.
1013     my $bootstrap = '/openils/conf/opensrf_core.xml';
1014     my $uname     = "STAFF_EQUIVALENT_USERNAME_HERE";
1015     my $password  = "STAFF_EQUIVALENT_PASSWORD";
1016
1017     # Bootstrap the client
1018     OpenSRF::System->bootstrap_client( config_file => $bootstrap );
1019     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
1020     Fieldmapper->import( IDL => $idl );
1021
1022     # Initialize CStoreEditor:
1023     OpenILS::Utils::CStoreEditor->init;
1024
1025     my $seed = OpenSRF::AppSession->create('open-ils.auth')
1026       ->request( 'open-ils.auth.authenticate.init', $uname )->gather(1);
1027
1028     return undef unless $seed;
1029
1030     my $response = OpenSRF::AppSession->create('open-ils.auth')->request(
1031         'open-ils.auth.authenticate.complete',
1032         {
1033             username => $uname,
1034             password => md5_hex( $seed . md5_hex($password) ),
1035             type     => 'staff'
1036         }
1037     )->gather(1);
1038
1039     return undef unless $response;
1040
1041     my %result;
1042     $result{'authtoken'}  = $response->{payload}->{authtoken};
1043     $result{'authtime'}   = $response->{payload}->{authtime};
1044     $result{'expiration'} = time() + $result{'authtime'}
1045       if ( defined( $result{'authtime'} ) );
1046     return %result;
1047 }
1048
1049 # Check the time versus the session expiration time and login again if
1050 # the session has expired, consequently resetting the session
1051 # paramters. We want to run this before doing anything that requires
1052 # us to have a current session in OpenSRF.
1053 #
1054 # Arguments
1055 # none
1056 #
1057 # Returns
1058 # Nothing
1059 sub check_session_time {
1060     if ( time() > $session{'expiration'} ) {
1061         %session = login();
1062         if ( !%session ) {
1063             die("Failed to reinitialize the session after expiration.");
1064         }
1065     }
1066 }
1067
1068 # Retrieve the logged in user.
1069 #
1070 sub get_session {
1071     my $response =
1072       OpenSRF::AppSession->create('open-ils.auth')
1073       ->request( 'open-ils.auth.session.retrieve', $session{authtoken} )
1074       ->gather(1);
1075     return $response;
1076 }
1077
1078 # Logout/destroy the OpenSRF session
1079 #
1080 # Argument is
1081 # none
1082 #
1083 # Returns
1084 # Does not return anything
1085 sub logout {
1086     if ( time() < $session{'expiration'} ) {
1087         my $response =
1088           OpenSRF::AppSession->create('open-ils.auth')
1089           ->request( 'open-ils.auth.session.delete', $session{authtoken} )
1090           ->gather(1);
1091         if ($response) {
1092
1093             # strong.silent.success
1094             exit(0);
1095         } else {
1096             fail("Logout unsuccessful. Good-bye, anyway.");
1097         }
1098     }
1099 }
1100
1101 sub update_copy {
1102     check_session_time();
1103     my ( $copy, $status_id ) = @_;
1104     my $e = new_editor( authtoken => $session{authtoken} );
1105     return $e->event->{textcode} unless ( $e->checkauth );
1106     $e->xact_begin;
1107     $copy->status($status_id);
1108     return $e->event unless $e->update_asset_copy($copy);
1109     $e->commit;
1110     return 'SUCCESS';
1111 }
1112
1113 # my paranoia re barcode on shipped items using visid for unique value
1114 sub update_copy_shipped {
1115     check_session_time();
1116     my ( $copy, $status_id, $barcode ) = @_;
1117     my $e = new_editor( authtoken => $session{authtoken} );
1118     return $e->event->{textcode} unless ( $e->checkauth );
1119     $e->xact_begin;
1120     $copy->status($status_id);
1121     $copy->barcode($barcode);
1122     return $e->event unless $e->update_asset_copy($copy);
1123     $e->commit;
1124     return 'SUCCESS';
1125 }
1126
1127 # Delete a copy
1128 #
1129 # Argument
1130 # Fieldmapper asset.copy object
1131 #
1132 # Returns
1133 # "SUCCESS" on success
1134 # Event textcode if an error occurs
1135 sub delete_copy {
1136     check_session_time();
1137     my ($copy) = @_;
1138
1139     my $e = new_editor( authtoken => $session{authtoken} );
1140     return $e->event->{textcode} unless ( $e->checkauth );
1141
1142     # Get the calnumber
1143     my $vol = $e->retrieve_asset_call_number( $copy->call_number );
1144     return $e->event->{textcode} unless ($vol);
1145
1146     # Get the biblio.record_entry
1147     my $bre = $e->retrieve_biblio_record_entry( $vol->record );
1148     return $e->event->{textcode} unless ($bre);
1149
1150     # Delete everything in a transaction and rollback if anything fails.
1151     $e->xact_begin;
1152     my $r;    # To hold results of editor calls
1153     $r = $e->delete_asset_copy($copy);
1154     unless ($r) {
1155         my $lval = $e->event->{textcode};
1156         $e->rollback;
1157         return $lval;
1158     }
1159     my $list =
1160       $e->search_asset_copy( { call_number => $vol->id, deleted => 'f' } );
1161     unless (@$list) {
1162         $r = $e->delete_asset_call_number($vol);
1163         unless ($r) {
1164             my $lval = $e->event->{textcode};
1165             $e->rollback;
1166             return $lval;
1167         }
1168         $list = $e->search_asset_call_number(
1169             { record => $bre->id, deleted => 'f' } );
1170         unless (@$list) {
1171             $bre->deleted('t');
1172             $r = $e->update_biblio_record_entry($bre);
1173             unless ($r) {
1174                 my $lval = $e->event->{textcode};
1175                 $e->rollback;
1176                 return $lval;
1177             }
1178         }
1179     }
1180     $e->commit;
1181     return 'SUCCESS';
1182 }
1183
1184 # Get asset.copy from asset.copy.barcode.
1185 # Arguments
1186 # copy barcode
1187 #
1188 # Returns
1189 # asset.copy fieldmaper object
1190 # or hash on error
1191 sub copy_from_barcode {
1192     check_session_time();
1193     my ($barcode) = @_;
1194     my $response =
1195       OpenSRF::AppSession->create('open-ils.search')
1196       ->request( 'open-ils.search.asset.copy.find_by_barcode', $barcode )
1197       ->gather(1);
1198     return $response;
1199 }
1200
1201 sub locid_from_barcode {
1202     my ($barcode) = @_;
1203     my $response =
1204       OpenSRF::AppSession->create('open-ils.search')
1205       ->request( 'open-ils.search.biblio.find_by_barcode', $barcode )
1206       ->gather(1);
1207     return $response->{ids}[0];
1208 }
1209
1210 # Convert a MARC::Record to XML for Evergreen
1211 #
1212 # Copied from Dyrcona's issa framework which copied
1213 # it from MVLC's Safari Load program which copied it
1214 # from some code in the Open-ILS example import scripts.
1215 #
1216 # Argument
1217 # A MARC::Record object
1218 #
1219 # Returns
1220 # String with XML for the MARC::Record as Evergreen likes it
1221 sub convert2marcxml {
1222     my $input = shift;
1223     ( my $xml = $input->as_xml_record() ) =~ s/\n//sog;
1224     $xml =~ s/^<\?xml.+\?\s*>//go;
1225     $xml =~ s/>\s+</></go;
1226     $xml =~ s/\p{Cc}//go;
1227     $xml = OpenILS::Application::AppUtils->entityize($xml);
1228     $xml =~ s/[\x00-\x1f]//go;
1229     return $xml;
1230 }
1231
1232 # Create a copy and marc record
1233 #
1234 # Arguments
1235 # title
1236 # call number
1237 # copy barcode
1238 #
1239 # Returns
1240 # bib id on succes
1241 # event textcode on failure
1242 sub create_copy {
1243     check_session_time();
1244     my ( $title, $callnumber, $barcode, $copy_status_id, $medium_type ) = @_;
1245
1246     my $e = new_editor( authtoken => $session{authtoken} );
1247     return $e->event->{textcode} unless ( $e->checkauth );
1248
1249     my $r = $e->allowed( [ 'CREATE_COPY', 'CREATE_MARC', 'CREATE_VOLUME' ] );
1250     if ( ref($r) eq 'HASH' ) {
1251         return $r->{textcode} . ' ' . $r->{ilsperm};
1252     }
1253
1254     # Check if the barcode exists in asset.copy and bail if it does.
1255     my $list = $e->search_asset_copy( { deleted => 'f', barcode => $barcode } );
1256     if (@$list) {
1257
1258 # in the future, can we update it, if it exists and only if it is an INN-Reach status item ?
1259         $e->finish;
1260         fail( 'BARCODE_EXISTS ! Barcode : ' . $barcode );
1261         die;
1262     }
1263
1264     # Create MARC record
1265     my $record = MARC::Record->new();
1266     $record->encoding('UTF-8');
1267     $record->leader('00881nam a2200193 4500');
1268     my $datespec = strftime( "%Y%m%d%H%M%S.0", localtime );
1269     my @fields = ();
1270     push( @fields, MARC::Field->new( '005', $datespec ) );
1271     push( @fields, MARC::Field->new( '082', '0', '4', 'a' => $callnumber ) );
1272     push( @fields, MARC::Field->new( '245', '0', '0', 'a' => $title ) );
1273     $record->append_fields(@fields);
1274
1275     # Convert the record to XML
1276     my $xml = convert2marcxml($record);
1277
1278     my $bre =
1279       OpenSRF::AppSession->create('open-ils.cat')
1280       ->request( 'open-ils.cat.biblio.record.xml.import',
1281         $session{authtoken}, $xml, 'System Local', 1 )->gather(1);
1282     return $bre->{textcode} if ( ref($bre) eq 'HASH' );
1283
1284     # Create volume record
1285     my $vol =
1286       OpenSRF::AppSession->create('open-ils.cat')
1287       ->request( 'open-ils.cat.call_number.find_or_create',
1288         $session{authtoken}, $callnumber, $bre->id, 3 )->gather(1);
1289     return $vol->{textcode} if ( $vol->{textcode} );
1290
1291     # Retrieve the user
1292     my $user = get_session;
1293
1294     # Create copy record
1295     my $copy = Fieldmapper::asset::copy->new();
1296     $copy->circ_modifier(qq($medium_type));
1297     $copy->barcode($barcode);
1298     $copy->call_number( $vol->{acn_id} );
1299     $copy->circ_lib(3);    # just testing with one circ_lib for now
1300     $copy->circulate('t');
1301     $copy->holdable('t');
1302     $copy->opac_visible('t');
1303     $copy->deleted('f');
1304     $copy->fine_level(2);
1305     $copy->loan_duration(2);
1306     $copy->location(1);
1307     $copy->status($copy_status_id);
1308     $copy->editor('1');
1309     $copy->creator('1');
1310
1311     # Add the configured stat cat entries.
1312     #my @stat_cats;
1313     #my $nodes = $xpath->find("/copy/stat_cat_entry");
1314     #foreach my $node ($nodes->get_nodelist) {
1315     #    next unless ($node->isa('XML::XPath::Node::Element'));
1316     #    my $stat_cat_id = $node->getAttribute('stat_cat');
1317     #    my $value = $node->string_value();
1318     #    # Need to search for an existing asset.stat_cat_entry
1319     my $asce = $e->search_asset_stat_cat_entry(
1320         { 'stat_cat' => $stat_cat_id, 'value' => $value } )->[0];
1321
1322     #    unless ($asce) {
1323     #        # if not, create a new one and use its id.
1324     #        $asce = Fieldmapper::asset::stat_cat_entry->new();
1325     #        $asce->stat_cat($stat_cat_id);
1326     #        $asce->value($value);
1327     #        $asce->owner($ou->id);
1328     #        $e->xact_begin;
1329     #        $asce = $e->create_asset_stat_cat_entry($asce);
1330     #        $e->xact_commit;
1331     #    }
1332     #    push(@stat_cats, $asce);
1333     #}
1334
1335     $e->xact_begin;
1336     $copy = $e->create_asset_copy($copy);
1337
1338     #if (scalar @stat_cats) {
1339     #    foreach my $asce (@stat_cats) {
1340     #        my $ascecm = Fieldmapper::asset::stat_cat_entry_copy_map->new();
1341     #        $ascecm->stat_cat($asce->stat_cat);
1342     #        $ascecm->stat_cat_entry($asce->id);
1343     #        $ascecm->owning_copy($copy->id);
1344     #        $ascecm = $e->create_asset_stat_cat_entry_copy_map($ascecm);
1345     #    }
1346     #}
1347     $e->commit;
1348     return $e->event->{textcode} unless ($r);
1349     return 'SUCCESS';
1350 }
1351
1352 # Checkout a copy to a patron
1353 #
1354 # Arguments
1355 # copy barcode
1356 # patron barcode
1357 #
1358 # Returns
1359 # textcode of the OSRF response.
1360 sub checkout {
1361     check_session_time();
1362     my ( $copy_barcode, $patron_barcode, $due_date ) = @_;
1363
1364     # Check for copy:
1365     my $copy = copy_from_barcode($copy_barcode);
1366     unless ( defined($copy) && blessed($copy) ) {
1367         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1368     }
1369
1370     # Check for user
1371     my $uid = user_id_from_barcode($patron_barcode);
1372     return 'PATRON_BARCODE_NOT_FOUND : ' . $patron_barcode if ( ref($uid) );
1373
1374     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1375         'open-ils.circ.checkout.full.override',
1376         $session{authtoken},
1377         {
1378             copy_barcode => $copy_barcode,
1379             patron_id    => $uid,
1380             due_date     => $due_date
1381         }
1382     )->gather(1);
1383     return $response->{textcode};
1384 }
1385
1386 sub renewal {
1387     check_session_time();
1388     my ( $copy_barcode, $due_date ) = @_;
1389
1390     # Check for copy:
1391     my $copy = copy_from_barcode($copy_barcode);
1392     unless ( defined($copy) && blessed($copy) ) {
1393         return 'COPY_BARCODE_NOT_FOUND : ' . $copy_barcode;
1394     }
1395
1396     my $response = OpenSRF::AppSession->create('open-ils.circ')->request(
1397         'open-ils.circ.renew.override',
1398         $session{authtoken},
1399         {
1400             copy_barcode => $copy_barcode,
1401             due_date     => $due_date
1402         }
1403     )->gather(1);
1404     return $response->{textcode};
1405 }
1406
1407 # Check a copy in
1408 #
1409 # Arguments
1410 # copy barcode
1411 #
1412 # Returns
1413 # "SUCCESS" on success
1414 # textcode of a failed OSRF request
1415 # 'COPY_NOT_CHECKED_OUT' when the copy is not checked out or not
1416 # checked out to the user's work_ou
1417
1418 sub checkin {
1419     check_session_time();
1420     my ($barcode) = @_;
1421
1422     my $copy = copy_from_barcode($barcode);
1423     return $copy->{textcode} unless ( blessed $copy);
1424
1425     return ("COPY_NOT_CHECKED_OUT $barcode")
1426       unless ( $copy->status == OILS_COPY_STATUS_CHECKED_OUT );
1427
1428     my $e = new_editor( authtoken => $session{authtoken} );
1429     return $e->event->{textcode} unless ( $e->checkauth );
1430
1431     my $circ = $e->search_action_circulation(
1432         [ { target_copy => $copy->id, xact_finish => undef } ] )->[0];
1433     my $r =
1434       OpenSRF::AppSession->create('open-ils.circ')
1435       ->request( 'open-ils.circ.checkin.override',
1436         $session{authtoken}, { force => 1, copy_id => $copy->id } )->gather(1);
1437     return 'SUCCESS' if ( $r->{textcode} eq 'ROUTE_ITEM' );
1438     return $r->{textcode};
1439 }
1440
1441 # Get actor.usr.id from barcode.
1442 # Arguments
1443 # patron barcode
1444 #
1445 # Returns
1446 # actor.usr.id
1447 # or hash on error
1448 sub user_id_from_barcode {
1449     check_session_time();
1450     my ($barcode) = @_;
1451
1452     my $response;
1453
1454     my $e = new_editor( authtoken => $session{authtoken} );
1455     return $response unless ( $e->checkauth );
1456
1457     my $card = $e->search_actor_card( { barcode => $barcode, active => 't' } );
1458     return $e->event unless ($card);
1459
1460     $response = $card->[0]->usr if (@$card);
1461
1462     $e->finish;
1463
1464     return $response;
1465 }
1466
1467 # Place a simple hold for a patron.
1468 #
1469 # Arguments
1470 # Target object appropriate for type of hold
1471 # Patron for whom the hold is place
1472 #
1473 # Returns
1474 # "SUCCESS" on success
1475 # textcode of a failed OSRF request
1476 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1477 # (Currently only support 'T' and 'C')
1478
1479 # simple hold should be removed and full holds sub should be used instead - pragmatic solution only
1480
1481 sub place_simple_hold {
1482     check_session_time();
1483
1484     #my ($type, $target, $patron, $pickup_ou) = @_;
1485     my ( $target, $patron_id ) = @_;
1486
1487     # NOTE : switch "t" to an "f" to make inactive hold active
1488     require '/openils/bin/oils_header.pl';    # XXX CUSTOMIZATION NEEDED XXX
1489     use vars qw/ $apputils $memcache $user $authtoken $authtime /;
1490
1491  # XXX: local opensrf core conf filename should be in config.
1492  # XXX: STAFF account with ncip service related permissions should be in config.
1493     osrf_connect("/openils/conf/opensrf_core.xml");
1494     oils_login( "STAFF_EQUIVALENT_USERNAME", "STAFF_EQUIVALENT_PASSWORD" );
1495     my $ahr = Fieldmapper::action::hold_request->new();
1496     $ahr->hold_type('C');
1497     # 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.
1498     $ahr->target($target);
1499     $ahr->usr($patron_id);
1500     $ahr->requestor(1);     # XXX CUSTOMIZATION NEEDED XXX admin user (?)
1501     $ahr->pickup_lib(2);    # XXX CUSTOMIZATION NEEDED XXX script user OU
1502     $ahr->phone_notify('');
1503     $ahr->email_notify(1);
1504     $ahr->frozen('t');
1505     my $resp = simplereq( CIRC(), 'open-ils.circ.holds.create', $authtoken, $ahr );
1506     my $e = new_editor( xact => 1, authtoken => $session{authtoken} );
1507     $ahr = $e->retrieve_action_hold_request($resp);    # refresh from db
1508     $ahr->frozen('f');
1509     $e->update_action_hold_request($ahr);
1510     $e->commit;
1511     $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $ahr->id );
1512
1513     #oils_event_die($resp);
1514     my $errors = "";
1515     if ( ref($resp) eq 'ARRAY' ) {
1516         ( $errors .= "error : " . $_->{textcode} ) for @$resp;
1517         return $errors;
1518     } elsif ( ref($resp) ne 'HASH' ) {
1519         return "Hold placed! hold_id = " . $resp . "\n";
1520     }
1521 }
1522
1523 # Place a hold for a patron.
1524 #
1525 # Arguments
1526 # Type of hold
1527 # Target object appropriate for type of hold
1528 # Patron for whom the hold is place
1529 # OU where hold is to be picked up
1530 #
1531 # Returns
1532 # "SUCCESS" on success
1533 # textcode of a failed OSRF request
1534 # "HOLD_TYPE_NOT_SUPPORTED" if the hold type is not supported
1535 # (Currently only support 'T' and 'C')
1536 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1537 #sub place_hold {
1538 #    check_session_time();
1539 #    my ( $type, $target, $patron, $pickup_ou ) = @_;
1540 #
1541 #    my $ou  = org_unit_from_shortname($work_ou);        # $work_ou is global
1542 #    my $ahr = Fieldmapper::action::hold_request->new;
1543 #    $ahr->hold_type($type);
1544 #    if ( $type eq 'C' ) {
1545 #
1546 #        # Check if we own the copy.
1547 #        if ( $ou->id == $target->circ_lib ) {
1548 #
1549 #            # We own it, so let's place a copy hold.
1550 #            $ahr->target( $target->id );
1551 #            $ahr->current_copy( $target->id );
1552 #        } else {
1553 #
1554 #            # We don't own it, so let's place a title hold instead.
1555 #            my $bib = bre_from_barcode( $target->barcode );
1556 #            $ahr->target( $bib->id );
1557 #            $ahr->hold_type('T');
1558 #        }
1559 #    } elsif ( $type eq 'T' ) {
1560 #        $ahr->target($target);
1561 #    } else {
1562 #        return "HOLD_TYPE_NOT_SUPPORTED";
1563 #    }
1564 #    $ahr->usr( user_id_from_barcode($id) );
1565 #
1566 #    #$ahr->pickup_lib($pickup_ou->id);
1567 #    $ahr->pickup_lib('3');
1568 #    if ( !$patron->email ) {
1569 #        $ahr->email_notify('f');
1570 #        $ahr->phone_notify( $patron->day_phone ) if ( $patron->day_phone );
1571 #    } else {
1572 #        $ahr->email_notify('t');
1573 #    }
1574 #
1575 #    # We must have a title hold and we want to change the hold
1576 #    # expiration date if we're sending the copy to the VC.
1577 #    set_title_hold_expiration($ahr) if ( $ahr->pickup_lib == $ou->id );
1578 #
1579 #    my $params = {
1580 #        pickup_lib => $ahr->pickup_lib,
1581 #        patronid   => $ahr->usr,
1582 #        hold_type  => $ahr->hold_type
1583 #    };
1584 #
1585 #    if ( $ahr->hold_type eq 'C' ) {
1586 #        $params->{copy_id} = $ahr->target;
1587 #    } else {
1588 #        $params->{titleid} = $ahr->target;
1589 #    }
1590 #
1591 #    my $r =
1592 #      OpenSRF::AppSession->create('open-ils.circ')
1593 #      ->request( 'open-ils.circ.title_hold.is_possible',
1594 #        $session{authtoken}, $params )->gather(1);
1595 #
1596 #    if ( $r->{textcode} ) {
1597 #        return $r->{textcode};
1598 #    } elsif ( $r->{success} ) {
1599 #        $r =
1600 #          OpenSRF::AppSession->create('open-ils.circ')
1601 #          ->request( 'open-ils.circ.holds.create.override',
1602 #            $session{authtoken}, $ahr )->gather(1);
1603 #
1604 #        my $returnValue = "SUCCESS";
1605 #        if ( ref($r) eq 'HASH' ) {
1606 #            $returnValue =
1607 #              ( $r->{textcode} eq 'PERM_FAILURE' )
1608 #              ? $r->{ilsperm}
1609 #              : $r->{textcode};
1610 #            $returnValue =~ s/\.override$//
1611 #              if ( $r->{textcode} eq 'PERM_FAILURE' );
1612 #        }
1613 #        return $returnValue;
1614 #    } else {
1615 #        return 'HOLD_NOT_POSSIBLE';
1616 #    }
1617 #}
1618
1619 # Set the expiration date on title holds
1620 #
1621 # Argument
1622 # Fieldmapper action.hold_request object
1623 #
1624 # Returns
1625 # Nothing
1626 # XXX NOT USED OR WORKING, COMMENTING OUT FOR NOW
1627 #sub set_title_hold_expiration {
1628 #    my $hold = shift;
1629 #    if ( $title_holds->{unit} && $title_holds->{duration} ) {
1630 #        my $expiration = DateTime->now( time_zone => $tz );
1631 #        $expiration->add( $title_holds->{unit} => $title_holds->{duration} );
1632 #        $hold->expire_time( $expiration->iso8601() );
1633 #    }
1634 #}
1635
1636 # Get actor.org_unit from the shortname
1637 #
1638 # Arguments
1639 # org_unit shortname
1640 #
1641 # Returns
1642 # Fieldmapper aou object
1643 # or HASH on error
1644 sub org_unit_from_shortname {
1645     check_session_time();
1646     my ($shortname) = @_;
1647     my $ou =
1648       OpenSRF::AppSession->create('open-ils.actor')
1649       ->request( 'open-ils.actor.org_unit.retrieve_by_shortname', $shortname )
1650       ->gather(1);
1651     return $ou;
1652 }
1653
1654 # Flesh user information
1655 # Arguments
1656 # actor.usr.id
1657 #
1658 # Returns
1659 # fieldmapped, fleshed user or
1660 # event hash on error
1661 sub flesh_user {
1662     check_session_time();
1663     my ($id) = @_;
1664     my $response =
1665       OpenSRF::AppSession->create('open-ils.actor')
1666       ->request( 'open-ils.actor.user.fleshed.retrieve',
1667         $session{'authtoken'}, $id,
1668         [ 'card', 'cards', 'standing_penalties', 'home_ou', 'profile' ] )
1669       ->gather(1);
1670     return $response;
1671 }