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