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