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