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