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