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