2 # ILS.pm: Test ILS interface module
6 use warnings; use strict;
8 use Sys::Syslog qw(syslog);
9 use Time::HiRes q/time/;
11 use OpenILS::SIP::Item;
12 use OpenILS::SIP::Patron;
13 use OpenILS::SIP::Transaction;
14 use OpenILS::SIP::Transaction::Checkout;
15 use OpenILS::SIP::Transaction::Checkin;
16 use OpenILS::SIP::Transaction::Renew;
17 use OpenILS::SIP::Transaction::FeePayment;
20 use OpenSRF::AppSession;
21 use OpenILS::Utils::Fieldmapper;
22 use OpenSRF::Utils::SettingsClient;
23 use OpenILS::Application::AppUtils;
24 use OpenSRF::Utils qw/:datetime/;
25 use DateTime::Format::ISO8601;
27 use Unicode::Normalize;
28 my $U = 'OpenILS::Application::AppUtils';
32 my $target_encoding; # FIXME: this is configured at the institution level.
34 use Digest::MD5 qw(md5_hex);
37 my ($class, $institution, $login) = @_;
38 my $type = ref($class) || $class;
41 $self->{login} = $login;
43 $config = $institution;
44 syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
45 $self->{institution} = $institution;
47 my $bsconfig = $institution->{implementation_config}->{bootstrap};
48 $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
50 syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
52 # ingress will persist throughout
53 OpenSRF::AppSession->ingress('sip2');
55 local $/ = "\n"; # why?
56 OpenSRF::System->bootstrap_client(config_file => $bsconfig);
57 syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
59 $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
61 Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
63 bless( $self, $type );
66 $self->login( $login->{id}, $login->{password} );
74 my $ses = $U->simplereq(
76 'open-ils.auth.session.retrieve', $self->{authtoken});
78 return undef if $U->event_code($ses); # auth timed out
79 return $self->{login_session} = $ses;
85 return 1 if $self->fetch_session;
87 syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
88 return $self->login( $self->{login}->{id}, $self->{login}->{password} );
92 return $editor = make_editor();
99 sub get_option_value {
100 my($self, $option) = @_;
101 my $ops = $config->{implementation_config}->{options}->{option};
102 $ops = [$ops] unless ref $ops eq 'ARRAY';
103 my @vals = grep { $_->{name} eq $option } @$ops;
104 return @vals ? $vals[0]->{value} : undef;
108 # Creates the global editor object
109 my $cstore_init = 1; # call init on first use
111 OpenILS::Utils::CStoreEditor::init() if $cstore_init;
113 return OpenILS::Utils::CStoreEditor->new;
116 =head2 clean_text(scalar)
118 Evergreen uses the UTF8 encoding for everything from the database up. Perl
119 doesn't know this, however, so we have to convince it to treat our UTF8 strings
120 as UTF8 strings. This may enable OpenNCIP to correctly calculate the checksums
121 for UTF8 text for SIP clients that support such modern options.
123 The target encoding is set in the <encoding> element of the SIPServer.pm
129 my $text = shift || '';
131 # Convert our incoming UTF8 data into Perl's internal string format
133 # Also convert to Normalization Form D, as the ASCII, iso-8859-1,
134 # and latin-1 encodings (at least) require this to substitute
135 # characters rather than simply returning a string truncated
136 # after the first non-ASCII character
137 $text = NFD(decode_utf8($text));
139 if ($target_encoding eq 'ascii') {
141 # Try to maintain a reasonable version of the content by
142 # stripping diacritics from the text, given that the SIP client
143 # wants just plain ASCII. This is the base requirement according
144 # to the SIP2 specification.
146 # Stripping the combining characters converts ""béè♁ts"
147 # into "bee?ts" instead of "b???ts" - better, eh?
151 # Characters that cannot be represented in the target encoding will
152 # generally be replaced with a question mark (?) character.
153 $text = encode($target_encoding, $text);
159 sub shortname_from_id {
160 my $id = shift or return;
161 return $id->shortname if ref $id;
162 return $org_sn_cache{$id} if $org_sn_cache{$id};
163 return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname;
165 sub patron_barcode_from_id {
166 my $id = shift or return;
167 return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
173 my $type = shift || 'dob';
175 return "" unless $date;
177 $date = DateTime::Format::ISO8601->new->
178 parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
179 my @time = localtime($date->epoch);
181 my $year = $time[5]+1900;
182 my $mon = $time[4]+1;
185 my $minute = $time[1];
186 my $second = $time[0];
188 $date = sprintf("%04d%02d%02d", $year, $mon, $day);
190 # Due dates need hyphen separators and time of day as well
191 if ($type eq 'due') {
192 $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
195 syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
202 my( $self, $username, $password ) = @_;
203 syslog('LOG_DEBUG', "OILS: Logging in with username $username");
205 my $seed = $U->simplereq(
207 'open-ils.auth.authenticate.init', $username );
209 my $response = $U->simplereq(
211 'open-ils.auth.authenticate.complete',
213 username => $username,
214 password => md5_hex($seed . md5_hex($password)),
219 if( my $code = $U->event_code($response) ) {
220 my $txt = $response->{textcode};
221 syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code");
225 my $key = $response->{payload}->{authtoken};
226 syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
228 $self->fetch_session; # to cache the login
230 return $self->{authtoken} = $key;
236 return OpenILS::SIP::Patron->new(@_);
242 return OpenILS::SIP::Item->new(@_);
248 return $self->{institution}->{id}; # consider making this return the whole institution
253 return $self->{institution}->{id}; # then use this for just the ID
257 my ($self, $op) = @_;
258 my ($i) = grep { $_->{name} eq $op }
259 @{$config->{implementation_config}->{supports}->{item}};
260 return to_bool($i->{value});
264 my ($self, $id, $whence) = @_;
265 if ($id ne $self->{institution}->{id}) {
266 syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
267 # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
274 # If it's defined, and matches a true sort of string, or is
275 # a non-zero number, then it's true.
276 defined($bool) or return; # false
277 ($bool =~ /true|y|yes/i) and return 1; # true
278 return ($bool =~ /^\d+$/ and $bool != 0); # true for non-zero numbers, false otherwise
282 return to_bool($config->{policy}->{checkout});
286 return to_bool($config->{policy}->{checkin});
290 return to_bool($config->{policy}->{renewal});
293 sub status_update_ok {
294 return to_bool($config->{policy}->{status_update});
298 return to_bool($config->{policy}->{offline});
304 ## Checkout(patron_id, item_id, sc_renew, fee_ack):
305 ## patron_id & item_id are the identifiers send by the terminal
306 ## sc_renew is the renewal policy configured on the terminal
307 ## returns a status opject that can be queried for the various bits
308 ## of information that the protocol (SIP or NCIP) needs to generate
310 ## fee_ack is the fee_acknowledged field (BO) sent from the sc
311 ## when doing chargeable loans.
315 my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
316 # In order to allow renewals the selfcheck AND the config have to say they are allowed
317 $sc_renew = (chr($sc_renew) eq 'Y' && $self->renew_ok());
319 $self->verify_session;
321 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
323 my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
324 my $patron = $self->find_patron($patron_id);
325 my $item = $self->find_item($item_id);
327 $xact->patron($patron);
331 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
335 if (!$patron->charge_ok) {
336 $xact->screen_msg("Patron Blocked");
341 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
345 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
347 if ($item->{patron} && ($item->{patron} eq $patron_id)) {
348 $xact->renew_ok(1); # So that accept/reject responses have the correct value later
350 syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
352 syslog('LOG_INFO', "OILS: OpenILS::Checkout appears to be renew, but renewal disallowed...");
353 $xact->screen_msg("Renewals not permitted");
355 return $xact; # Don't attempt later
357 } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
358 # I can't deal with this right now
359 # XXX check in then check out?
360 $xact->screen_msg("Item checked out to another patron");
362 return $xact; # Don't wipe out the screen message later
367 # Check for fee and $fee_ack. If there is a fee, and $fee_ack
368 # is 'Y', we proceed, otherwise we reject the checkout.
369 if ($item->fee > 0.0) {
370 $xact->fee_amount($item->fee);
371 $xact->sip_fee_type($item->sip_fee_type);
372 $xact->sip_currency($item->fee_currency);
373 if ($fee_ack && $fee_ack eq 'Y') {
376 $xact->screen_msg('Fee required');
382 $xact->do_checkout($sc_renew);
383 $xact->desensitize(!$item->magnetic);
387 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
388 "patron %s checkout %s succeeded", $patron_id, $item_id);
390 #editor()->xact_rollback;
391 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
392 "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
400 my ($self, $item_id, $inst_id, $trans_date, $return_date,
401 $current_loc, $item_props, $cancel) = @_;
403 my $start_time = time();
405 $self->verify_session;
407 syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
409 my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
410 my $item = OpenILS::SIP::Item->new($item_id);
412 unless ( $xact->item($item) ) {
414 # $circ->alert(1); $circ->alert_type(99);
415 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
416 syslog('LOG_INFO', "OILS: Checkin failed. " . $xact->screen_msg() );
420 $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
423 $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
424 delete $item->{patron};
425 delete $item->{due_date};
426 syslog('LOG_INFO', "OILS: Checkin succeeded");
428 syslog('LOG_WARNING', "OILS: Checkin failed");
431 syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
435 ## If the ILS caches patron information, this lets it free it up.
436 ## Also, this could be used for centrally logging session duration.
437 ## We don't do anything with it.
438 sub end_patron_session {
439 my ($self, $patron_id) = @_;
440 return (1, 'Thank you!', '');
445 my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
446 $pay_type, $fee_id, $trans_id, $currency) = @_;
448 $self->verify_session;
450 my $xact = OpenILS::SIP::Transaction::FeePayment->new(authtoken => $self->{authtoken});
451 my $patron = $self->find_patron($patron_id);
454 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
459 $xact->patron($patron);
460 $xact->sip_currency($currency);
461 $xact->fee_amount($fee_amt);
462 $xact->sip_fee_type($fee_type);
463 $xact->transaction_id($trans_id);
464 $xact->fee_id($fee_id);
465 # We don't presently use these, but we might in the future.
466 $xact->patron_password($patron_pwd);
467 $xact->sip_payment_type($pay_type);
469 $xact->do_fee_payment();
475 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
476 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
477 # my ($patron, $item);
482 # $trans = new ILS::Transaction::Hold;
484 # # BEGIN TRANSACTION
485 # $patron = new ILS::Patron $patron_id;
487 # || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
488 # $trans->screen_msg("Invalid Patron.");
493 # $item = new ILS::Item ($item_id || $title_id);
495 # $trans->screen_msg("No such item.");
497 # # END TRANSACTION (conditionally)
499 # } elsif ($item->fee && ($fee_ack ne 'Y')) {
500 # $trans->screen_msg = "Fee required to place hold.";
502 # # END TRANSACTION (conditionally)
507 # item_id => $item->id,
508 # patron_id => $patron->id,
509 # expiration_date => $expiry_date,
510 # pickup_location => $pickup_location,
511 # hold_type => $hold_type,
515 # $trans->patron($patron);
516 # $trans->item($item);
517 # $trans->pickup_location($pickup_location);
519 # push(@{$item->hold_queue}, $hold);
520 # push(@{$patron->{hold_items}}, $hold);
528 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
529 # my ($patron, $item, $hold);
532 # $trans = new ILS::Transaction::Hold;
534 # # BEGIN TRANSACTION
535 # $patron = new ILS::Patron $patron_id;
537 # $trans->screen_msg("Invalid patron barcode.");
540 # } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
541 # $trans->screen_msg('Invalid patron password.');
546 # $item = new ILS::Item ($item_id || $title_id);
548 # $trans->screen_msg("No such item.");
550 # # END TRANSACTION (conditionally)
554 # # Remove the hold from the patron's record first
555 # $trans->ok($patron->drop_hold($item_id));
558 # # We didn't find it on the patron record
559 # $trans->screen_msg("No such hold on patron record.");
561 # # END TRANSACTION (conditionally)
565 # # Now, remove it from the item record. If it was on the patron
566 # # record but not on the item record, we'll treat that as success.
567 # foreach my $i (0 .. scalar @{$item->hold_queue}) {
568 # $hold = $item->hold_queue->[$i];
570 # if ($hold->{patron_id} eq $patron->id) {
571 # # found it: delete it.
572 # splice @{$item->hold_queue}, $i, 1;
577 # $trans->screen_msg("Hold Cancelled.");
578 # $trans->patron($patron);
579 # $trans->item($item);
585 ## The patron and item id's can't be altered, but the
586 ## date, location, and type can.
588 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
589 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
590 # my ($patron, $item);
594 # $trans = new ILS::Transaction::Hold;
596 # # BEGIN TRANSACTION
597 # $patron = new ILS::Patron $patron_id;
599 # $trans->screen_msg("Invalid patron barcode.");
604 # foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
605 # $hold = $patron->{hold_items}[$i];
607 # if ($hold->{item_id} eq $item_id) {
608 # # Found it. So fix it.
609 # $hold->{expiration_date} = $expiry_date if $expiry_date;
610 # $hold->{pickup_location} = $pickup_location if $pickup_location;
611 # $hold->{hold_type} = $hold_type if $hold_type;
614 # $trans->screen_msg("Hold updated.");
615 # $trans->patron($patron);
616 # $trans->item(new ILS::Item $hold->{item_id});
621 # # The same hold structure is linked into both the patron's
622 # # list of hold items and into the queue of outstanding holds
623 # # for the item, so we don't need to search the hold queue for
624 # # the item, since it's already been updated by the patron code.
627 # $trans->screen_msg("No such outstanding hold.");
635 my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
636 $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
638 $self->verify_session;
640 my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
641 $trans->patron($self->find_patron($patron_id));
642 $trans->item($self->find_item($item_id));
644 if(!$trans->patron) {
645 $trans->screen_msg("Invalid patron barcode.");
650 if(!$trans->patron->renew_ok) {
651 $trans->screen_msg("Renewals not allowed.");
658 $trans->screen_msg("Title ID renewal not supported. Use item barcode.");
660 $trans->screen_msg("Invalid item barcode.");
666 if(!$trans->item->{patron} or
667 $trans->item->{patron} ne $patron_id) {
668 $trans->screen_msg("Item not checked out to " . $trans->patron->name);
673 # Perform the renewal
676 $trans->desensitize(0); # It's already checked out
677 $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
678 $trans->item->{sip_item_properties} = $item_props if $item_props;
689 # my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
690 # my ($patron, $item_id);
693 # $trans = new ILS::Transaction::RenewAll;
695 # $trans->patron($patron = new ILS::Patron $patron_id);
696 # if (defined $patron) {
697 # syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
698 # $patron->name, $patron->renew_ok);
700 # syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
704 # if (!defined($patron)) {
705 # $trans->screen_msg("Invalid patron barcode.");
707 # } elsif (!$patron->renew_ok) {
708 # $trans->screen_msg("Renewals not allowed.");
710 # } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
711 # $trans->screen_msg("Invalid patron password.");
715 # foreach $item_id (@{$patron->{items}}) {
716 # my $item = new ILS::Item $item_id;
718 # if (!defined($item)) {
719 # syslog("LOG_WARNING",
720 # "renew_all: Invalid item id associated with patron '%s'",
725 # if (@{$item->hold_queue}) {
726 # # Can't renew if there are outstanding holds
727 # push @{$trans->unrenewed}, $item_id;
729 # $item->{due_date} = time + (14*24*60*60); # two weeks hence
730 # push @{$trans->renewed}, $item_id;