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