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