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;
19 use OpenILS::Utils::Fieldmapper;
20 use OpenSRF::Utils::SettingsClient;
21 use OpenILS::Application::AppUtils;
22 use OpenSRF::Utils qw/:datetime/;
23 use DateTime::Format::ISO8601;
25 use Unicode::Normalize;
26 my $U = 'OpenILS::Application::AppUtils';
30 my $target_encoding; # FIXME: this is configured at the institution level.
32 use Digest::MD5 qw(md5_hex);
35 my ($class, $institution, $login) = @_;
36 my $type = ref($class) || $class;
39 $self->{login} = $login;
41 $config = $institution;
42 syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
43 $self->{institution} = $institution;
45 my $bsconfig = $institution->{implementation_config}->{bootstrap};
46 $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
48 syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
50 local $/ = "\n"; # why?
51 OpenSRF::System->bootstrap_client(config_file => $bsconfig);
52 syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
54 $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
56 Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
58 bless( $self, $type );
61 $self->login( $login->{id}, $login->{password} );
69 my $ses = $U->simplereq(
71 'open-ils.auth.session.retrieve', $self->{authtoken});
73 return undef if $U->event_code($ses); # auth timed out
74 return $self->{login_session} = $ses;
80 return 1 if $self->fetch_session;
82 syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
83 return $self->login( $self->{login}->{id}, $self->{login}->{password} );
87 return $editor = make_editor();
94 sub get_option_value {
95 my($self, $option) = @_;
96 my $ops = $config->{implementation_config}->{options}->{option};
97 $ops = [$ops] unless ref $ops eq 'ARRAY';
98 my @vals = grep { $_->{name} eq $option } @$ops;
99 return @vals ? $vals[0]->{value} : undef;
103 # Creates the global editor object
104 my $cstore_init = 1; # call init on first use
106 OpenILS::Utils::CStoreEditor::init() if $cstore_init;
108 return OpenILS::Utils::CStoreEditor->new;
111 =head2 clean_text(scalar)
113 Evergreen uses the UTF8 encoding for everything from the database up. Perl
114 doesn't know this, however, so we have to convince it to treat our UTF8 strings
115 as UTF8 strings. This may enable OpenNCIP to correctly calculate the checksums
116 for UTF8 text for SIP clients that support such modern options.
118 The target encoding is set in the <encoding> element of the SIPServer.pm
124 my $text = shift || '';
126 # Convert our incoming UTF8 data into Perl's internal string format
128 # Also convert to Normalization Form D, as the ASCII, iso-8859-1,
129 # and latin-1 encodings (at least) require this to substitute
130 # characters rather than simply returning a string truncated
131 # after the first non-ASCII character
132 $text = NFD(decode_utf8($text));
134 if ($target_encoding eq 'ascii') {
136 # Try to maintain a reasonable version of the content by
137 # stripping diacritics from the text, given that the SIP client
138 # wants just plain ASCII. This is the base requirement according
139 # to the SIP2 specification.
141 # Stripping the combining characters converts ""béè♁ts"
142 # into "bee?ts" instead of "b???ts" - better, eh?
146 # Characters that cannot be represented in the target encoding will
147 # generally be replaced with a question mark (?) character.
148 $text = encode($target_encoding, $text);
154 sub shortname_from_id {
155 my $id = shift or return;
156 return $id->shortname if ref $id;
157 return $org_sn_cache{$id} if $org_sn_cache{$id};
158 return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname;
160 sub patron_barcode_from_id {
161 my $id = shift or return;
162 return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
168 my $type = shift || 'dob';
170 return "" unless $date;
172 $date = DateTime::Format::ISO8601->new->
173 parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
174 my @time = localtime($date->epoch);
176 my $year = $time[5]+1900;
177 my $mon = $time[4]+1;
180 my $minute = $time[1];
181 my $second = $time[0];
183 $date = sprintf("%04d%02d%02d", $year, $mon, $day);
185 # Due dates need hyphen separators and time of day as well
186 if ($type eq 'due') {
187 $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
190 syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
197 my( $self, $username, $password ) = @_;
198 syslog('LOG_DEBUG', "OILS: Logging in with username $username");
200 my $seed = $U->simplereq(
202 'open-ils.auth.authenticate.init', $username );
204 my $response = $U->simplereq(
206 'open-ils.auth.authenticate.complete',
208 username => $username,
209 password => md5_hex($seed . md5_hex($password)),
214 if( my $code = $U->event_code($response) ) {
215 my $txt = $response->{textcode};
216 syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code");
220 my $key = $response->{payload}->{authtoken};
221 syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
223 $self->fetch_session; # to cache the login
225 return $self->{authtoken} = $key;
231 return OpenILS::SIP::Patron->new(@_);
237 return OpenILS::SIP::Item->new(@_);
243 return $self->{institution}->{id}; # consider making this return the whole institution
248 return $self->{institution}->{id}; # then use this for just the ID
252 my ($self, $op) = @_;
253 my ($i) = grep { $_->{name} eq $op }
254 @{$config->{implementation_config}->{supports}->{item}};
255 return to_bool($i->{value});
259 my ($self, $id, $whence) = @_;
260 if ($id ne $self->{institution}->{id}) {
261 syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
262 # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
269 # If it's defined, and matches a true sort of string, or is
270 # a non-zero number, then it's true.
271 defined($bool) or return; # false
272 ($bool =~ /true|y|yes/i) and return 1; # true
273 return ($bool =~ /^\d+$/ and $bool != 0); # true for non-zero numbers, false otherwise
277 return to_bool($config->{policy}->{checkout});
281 return to_bool($config->{policy}->{checkin});
285 return to_bool($config->{policy}->{renew});
288 sub status_update_ok {
289 return to_bool($config->{policy}->{status_update});
293 return to_bool($config->{policy}->{offline});
299 ## Checkout(patron_id, item_id, sc_renew):
300 ## patron_id & item_id are the identifiers send by the terminal
301 ## sc_renew is the renewal policy configured on the terminal
302 ## returns a status opject that can be queried for the various bits
303 ## of information that the protocol (SIP or NCIP) needs to generate
308 my ($self, $patron_id, $item_id, $sc_renew) = @_;
311 $self->verify_session;
313 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
315 my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
316 my $patron = $self->find_patron($patron_id);
317 my $item = $self->find_item($item_id);
319 $xact->patron($patron);
323 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
327 if (!$patron->charge_ok) {
328 $xact->screen_msg("Patron Blocked");
333 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
337 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
339 if ($item->{patron} && ($item->{patron} eq $patron_id)) {
340 syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
342 } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
343 # I can't deal with this right now
344 # XXX check in then check out?
345 $xact->screen_msg("Item checked out to another patron");
349 $xact->do_checkout($sc_renew);
350 $xact->desensitize(!$item->magnetic);
354 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
355 "patron %s checkout %s succeeded", $patron_id, $item_id);
357 #editor()->xact_rollback;
358 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
359 "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
367 my ($self, $item_id, $inst_id, $trans_date, $return_date,
368 $current_loc, $item_props, $cancel) = @_;
370 my $start_time = time();
372 $self->verify_session;
374 syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
376 my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
377 my $item = OpenILS::SIP::Item->new($item_id);
379 unless ( $xact->item($item) ) {
381 # $circ->alert(1); $circ->alert_type(99);
382 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
383 syslog('LOG_INFO', "OILS: Checkin failed. " . $xact->screen_msg() );
387 $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
390 $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
391 delete $item->{patron};
392 delete $item->{due_date};
393 syslog('LOG_INFO', "OILS: Checkin succeeded");
395 syslog('LOG_WARNING', "OILS: Checkin failed");
398 syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
402 ## If the ILS caches patron information, this lets it free it up.
403 ## Also, this could be used for centrally logging session duration.
404 ## We don't do anything with it.
405 sub end_patron_session {
406 my ($self, $patron_id) = @_;
407 return (1, 'Thank you!', '');
412 # my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
413 # $pay_type, $fee_id, $trans_id, $currency) = @_;
417 # $trans = new ILS::Transaction::FeePayment;
419 # $patron = new ILS::Patron $patron_id;
421 # $trans->transaction_id($trans_id);
422 # $trans->patron($patron);
429 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
430 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
431 # my ($patron, $item);
436 # $trans = new ILS::Transaction::Hold;
438 # # BEGIN TRANSACTION
439 # $patron = new ILS::Patron $patron_id;
441 # || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
442 # $trans->screen_msg("Invalid Patron.");
447 # $item = new ILS::Item ($item_id || $title_id);
449 # $trans->screen_msg("No such item.");
451 # # END TRANSACTION (conditionally)
453 # } elsif ($item->fee && ($fee_ack ne 'Y')) {
454 # $trans->screen_msg = "Fee required to place hold.";
456 # # END TRANSACTION (conditionally)
461 # item_id => $item->id,
462 # patron_id => $patron->id,
463 # expiration_date => $expiry_date,
464 # pickup_location => $pickup_location,
465 # hold_type => $hold_type,
469 # $trans->patron($patron);
470 # $trans->item($item);
471 # $trans->pickup_location($pickup_location);
473 # push(@{$item->hold_queue}, $hold);
474 # push(@{$patron->{hold_items}}, $hold);
482 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
483 # my ($patron, $item, $hold);
486 # $trans = new ILS::Transaction::Hold;
488 # # BEGIN TRANSACTION
489 # $patron = new ILS::Patron $patron_id;
491 # $trans->screen_msg("Invalid patron barcode.");
494 # } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
495 # $trans->screen_msg('Invalid patron password.');
500 # $item = new ILS::Item ($item_id || $title_id);
502 # $trans->screen_msg("No such item.");
504 # # END TRANSACTION (conditionally)
508 # # Remove the hold from the patron's record first
509 # $trans->ok($patron->drop_hold($item_id));
512 # # We didn't find it on the patron record
513 # $trans->screen_msg("No such hold on patron record.");
515 # # END TRANSACTION (conditionally)
519 # # Now, remove it from the item record. If it was on the patron
520 # # record but not on the item record, we'll treat that as success.
521 # foreach my $i (0 .. scalar @{$item->hold_queue}) {
522 # $hold = $item->hold_queue->[$i];
524 # if ($hold->{patron_id} eq $patron->id) {
525 # # found it: delete it.
526 # splice @{$item->hold_queue}, $i, 1;
531 # $trans->screen_msg("Hold Cancelled.");
532 # $trans->patron($patron);
533 # $trans->item($item);
539 ## The patron and item id's can't be altered, but the
540 ## date, location, and type can.
542 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
543 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
544 # my ($patron, $item);
548 # $trans = new ILS::Transaction::Hold;
550 # # BEGIN TRANSACTION
551 # $patron = new ILS::Patron $patron_id;
553 # $trans->screen_msg("Invalid patron barcode.");
558 # foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
559 # $hold = $patron->{hold_items}[$i];
561 # if ($hold->{item_id} eq $item_id) {
562 # # Found it. So fix it.
563 # $hold->{expiration_date} = $expiry_date if $expiry_date;
564 # $hold->{pickup_location} = $pickup_location if $pickup_location;
565 # $hold->{hold_type} = $hold_type if $hold_type;
568 # $trans->screen_msg("Hold updated.");
569 # $trans->patron($patron);
570 # $trans->item(new ILS::Item $hold->{item_id});
575 # # The same hold structure is linked into both the patron's
576 # # list of hold items and into the queue of outstanding holds
577 # # for the item, so we don't need to search the hold queue for
578 # # the item, since it's already been updated by the patron code.
581 # $trans->screen_msg("No such outstanding hold.");
589 my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
590 $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
592 $self->verify_session;
594 my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
595 $trans->patron($self->find_patron($patron_id));
596 $trans->item($self->find_item($item_id));
598 if(!$trans->patron) {
599 $trans->screen_msg("Invalid patron barcode.");
604 if(!$trans->patron->renew_ok) {
605 $trans->screen_msg("Renewals not allowed.");
612 $trans->screen_msg("Title ID renewal not supported. Use item barcode.");
614 $trans->screen_msg("Invalid item barcode.");
620 if(!$trans->item->{patron} or
621 $trans->item->{patron} ne $patron_id) {
622 $trans->screen_msg("Item not checked out to " . $trans->patron->name);
627 # Perform the renewal
630 $trans->desensitize(0); # It's already checked out
631 $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
632 $trans->item->{sip_item_properties} = $item_props if $item_props;
643 # my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
644 # my ($patron, $item_id);
647 # $trans = new ILS::Transaction::RenewAll;
649 # $trans->patron($patron = new ILS::Patron $patron_id);
650 # if (defined $patron) {
651 # syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
652 # $patron->name, $patron->renew_ok);
654 # syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
658 # if (!defined($patron)) {
659 # $trans->screen_msg("Invalid patron barcode.");
661 # } elsif (!$patron->renew_ok) {
662 # $trans->screen_msg("Renewals not allowed.");
664 # } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
665 # $trans->screen_msg("Invalid patron password.");
669 # foreach $item_id (@{$patron->{items}}) {
670 # my $item = new ILS::Item $item_id;
672 # if (!defined($item)) {
673 # syslog("LOG_WARNING",
674 # "renew_all: Invalid item id associated with patron '%s'",
679 # if (@{$item->hold_queue}) {
680 # # Can't renew if there are outstanding holds
681 # push @{$trans->unrenewed}, $item_id;
683 # $item->{due_date} = time + (14*24*60*60); # two weeks hence
684 # push @{$trans->renewed}, $item_id;