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