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::RenewAll;
18 use OpenILS::SIP::Transaction::FeePayment;
19 use OpenILS::SIP::Transaction::Hold;
22 use OpenSRF::AppSession;
23 use OpenILS::Utils::Fieldmapper;
24 use OpenSRF::Utils::SettingsClient;
25 use OpenILS::Application::AppUtils;
26 use OpenILS::Utils::DateTime qw/:datetime/;
27 use DateTime::Format::ISO8601;
29 my $U = 'OpenILS::Application::AppUtils';
34 my $target_encoding; # FIXME: this is configured at the institution level.
36 use Digest::MD5 qw(md5_hex);
38 # Copied from Sip::Constants
40 SIP_DATETIME => "%Y%m%d %H%M%S",
44 OpenSRF::Transport::PeerHandle->retrieve->disconnect
48 my ($class, $institution, $login, $state) = @_;
49 my $type = ref($class) || $class;
52 $self->{login} = $login_account = $login;
54 $config = $institution;
55 syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
56 $self->{institution} = $institution;
58 my $bsconfig = $institution->{implementation_config}->{bootstrap};
59 $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
61 syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
63 # ingress will persist throughout
64 OpenSRF::AppSession->ingress('sip2');
66 local $/ = "\n"; # why?
67 OpenSRF::System->bootstrap_client(config_file => $bsconfig);
68 syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
70 $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
72 Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
74 bless( $self, $type );
77 $self->login( $login->{id}, $login->{password}, $state );
85 my $ses = $U->simplereq(
87 'open-ils.auth.session.retrieve', $self->{authtoken});
89 return undef if $U->event_code($ses); # auth timed out
90 return $self->{login_session} = $ses;
96 return 1 if $self->fetch_session;
98 syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
99 return $self->login( $self->{login}->{id}, $self->{login}->{password} );
103 return $editor = make_editor();
110 return $login_account;
113 sub get_option_value {
114 my($self, $option) = @_;
115 my $ops = $config->{implementation_config}->{options}->{option};
116 $ops = [$ops] unless ref $ops eq 'ARRAY';
117 my @vals = grep { $_->{name} eq $option } @$ops;
118 return @vals ? $vals[0]->{value} : undef;
122 # Creates the global editor object
123 my $cstore_init = 1; # call init on first use
125 OpenILS::Utils::CStoreEditor::init() if $cstore_init;
127 return OpenILS::Utils::CStoreEditor->new;
131 sub shortname_from_id {
132 my $id = shift or return;
133 return $id->shortname if ref $id;
134 return $org_sn_cache{$id} if $org_sn_cache{$id};
135 return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname;
137 sub patron_barcode_from_id {
138 my $id = shift or return;
139 return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
145 my $type = shift || '';
147 return "" unless $date;
149 my $dt = DateTime::Format::ISO8601->new->
150 parse_datetime(clean_ISO8601($date));
152 # actor.usr.dob stores dates without time/timezone, which causes
153 # DateTime to assume the date is stored as UTC. Tell DateTime
154 # to use the local time zone, instead.
155 # Other dates will have time zones and should be parsed as-is.
156 $dt->set_time_zone('local') if $type eq 'dob';
158 my @time = localtime($dt->epoch);
160 my $year = $time[5]+1900;
161 my $mon = $time[4]+1;
164 my $minute = $time[1];
165 my $second = $time[0];
167 $date = sprintf("%04d%02d%02d", $year, $mon, $day);
169 # Due dates need hyphen separators and time of day as well
170 if ($type eq 'due') {
172 my $use_sdf = $class->get_option_value('use_sip_date_format') || '';
174 if ($use_sdf =~ /true/i) {
175 $date = $dt->strftime(SIP_DATETIME);
178 $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d",
179 $year, $mon, $day, $hour, $minute, $second);
183 syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
190 my( $self, $username, $password, $state ) = @_;
191 syslog('LOG_DEBUG', "OILS: Logging in with username $username");
194 if ($state and ref $state and $$state{authtoken}) {
195 $self->{authtoken} = $$state{authtoken};
196 return $self->{authtoken} if ($self->fetch_session); # fetch the session
199 my $nonce = rand($$);
201 my $seed = $U->simplereq(
203 'open-ils.auth.authenticate.init', $username, $nonce );
207 username => $username,
208 password => md5_hex($seed . md5_hex($password)),
213 if ($self->{login}->{location}) {
214 $opts->{workstation} = $self->{login}->{location};
217 my $response = $U->simplereq(
219 'open-ils.auth.authenticate.complete',
223 if( my $code = $U->event_code($response) ) {
224 my $txt = $response->{textcode};
225 syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code");
229 my $key = $response->{payload}->{authtoken};
230 syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
232 $self->{authtoken} = $key;
234 $self->fetch_session; # to cache the login
241 return { authtoken => $self->{authtoken} };
247 my $sess = $self->fetch_session;
248 my $ou = (ref($sess->home_ou)) ? $sess->home_ou->id : $sess->home_ou;
250 $ou = (ref($sess->ws_ou)) ? $sess->ws_ou->id : $sess->ws_ou;
252 return $U->ou_ancestor_setting_value($ou, $setting);
255 sub get_barcode_regex {
257 if (!defined($self->{bc_regex})) {
258 $self->{bc_regex} = $self->get_ou_setting('opac.barcode_regex');
259 $self->{bc_regex} = '^\d' unless ($self->{bc_regex});
261 return $self->{bc_regex};
265 # find_patron($barcode);
266 # find_patron(barcode => $barcode); # same as above
267 # find_patron(usr => $id);
268 # find_patron(usrname => $usrname);
272 my $key = (@_ > 1) ? shift : 'barcode'; # if we have multiple args, the first is the key index (default barcode)
273 my $patron_id = shift;
276 $self->get_option_value('support_patron_username_login') || '';
278 if (to_bool($use_username)) {
279 # Check for usrname or barcode in the same, simple way that the OPAC does.
280 my $bc_regex = $self->get_barcode_regex();
281 if ($key eq 'barcode' && $patron_id !~ /$bc_regex/) {
286 $self->verify_session;
287 return OpenILS::SIP::Patron->new($key => $patron_id, authtoken => $self->{authtoken}, @_);
293 $self->verify_session;
294 return OpenILS::SIP::Item->new(@_);
300 return $self->{institution}->{id}; # consider making this return the whole institution
305 return $self->{institution}->{id}; # then use this for just the ID
309 my ($self, $op) = @_;
310 my ($i) = grep { $_->{name} eq $op }
311 @{$config->{implementation_config}->{supports}->{item}};
312 return to_bool($i->{value});
316 my ($self, $id, $whence) = @_;
317 if ($id ne $self->{institution}->{id}) {
318 syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
319 # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
326 # If it's defined, and matches a true sort of string, or is
327 # a non-zero number, then it's true.
328 defined($bool) or return; # false
329 ($bool =~ /true|y|yes/i) and return 1; # true
330 return ($bool =~ /^\d+$/ and $bool != 0); # true for non-zero numbers, false otherwise
334 return to_bool($config->{policy}->{checkout});
338 return to_bool($config->{policy}->{checkin});
342 return to_bool($config->{policy}->{renewal});
345 sub status_update_ok {
346 return to_bool($config->{policy}->{status_update});
350 return to_bool($config->{policy}->{offline});
356 ## Checkout(patron_id, item_id, sc_renew, fee_ack):
357 ## patron_id & item_id are the identifiers send by the terminal
358 ## sc_renew is the renewal policy configured on the terminal
359 ## returns a status opject that can be queried for the various bits
360 ## of information that the protocol (SIP or NCIP) needs to generate
362 ## fee_ack is the fee_acknowledged field (BO) sent from the sc
363 ## when doing chargeable loans.
367 my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
368 # In order to allow renewals the selfcheck AND the config have to say they are allowed
369 $sc_renew = (chr($sc_renew) eq 'Y' && $self->renew_ok());
371 $self->verify_session;
373 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
375 my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
376 my $patron = $self->find_patron($patron_id);
377 my $item = $self->find_item($item_id);
379 $xact->patron($patron);
383 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
387 if (!$patron->charge_ok) {
388 $xact->screen_msg("Patron Blocked");
393 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
397 syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
399 if ($item->{patron} && ($item->{patron} eq $patron_id)) {
400 $xact->renew_ok(1); # So that accept/reject responses have the correct value later
402 syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
404 syslog('LOG_INFO', "OILS: OpenILS::Checkout appears to be renew, but renewal disallowed...");
405 $xact->screen_msg("Renewals not permitted");
407 return $xact; # Don't attempt later
409 } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
410 # I can't deal with this right now
411 # XXX check in then check out?
412 $xact->screen_msg("Item checked out to another patron");
414 return $xact; # Don't wipe out the screen message later
419 # Check for fee and $fee_ack. If there is a fee, and $fee_ack
420 # is 'Y', we proceed, otherwise we reject the checkout.
421 if ($item->fee > 0.0) {
422 $xact->fee_amount($item->fee);
423 $xact->sip_fee_type($item->sip_fee_type);
424 $xact->sip_currency($item->fee_currency);
425 if ($fee_ack && $fee_ack eq 'Y') {
428 $xact->screen_msg('Fee required');
434 $xact->do_checkout($sc_renew);
435 $xact->desensitize(!$item->magnetic);
439 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
440 "patron %s checkout %s succeeded", $patron_id, $item_id);
442 #editor()->xact_rollback;
443 syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
444 "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
452 my ($self, $item_id, $inst_id, $trans_date, $return_date,
453 $current_loc, $item_props, $cancel) = @_;
455 my $start_time = time();
457 $self->verify_session;
459 syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
461 my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
462 my $item = OpenILS::SIP::Item->new($item_id);
464 unless ( $xact->item($item) ) {
466 # $circ->alert(1); $circ->alert_type(99);
467 $xact->screen_msg("Invalid Item Barcode: '$item_id'");
468 syslog('LOG_INFO', "OILS: Checkin failed. " . $xact->screen_msg() );
472 $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
475 $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
476 delete $item->{patron};
477 delete $item->{due_date};
478 syslog('LOG_INFO', "OILS: Checkin succeeded");
480 syslog('LOG_WARNING', "OILS: Checkin failed");
483 syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
487 ## If the ILS caches patron information, this lets it free it up.
488 ## Also, this could be used for centrally logging session duration.
489 ## We don't do anything with it.
490 sub end_patron_session {
491 my ($self, $patron_id) = @_;
492 return (1, 'Thank you!', '');
497 my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
498 $pay_type, $fee_id, $trans_id, $currency) = @_;
500 $self->verify_session;
502 my $xact = OpenILS::SIP::Transaction::FeePayment->new(authtoken => $self->{authtoken});
503 my $patron = $self->find_patron($patron_id);
506 $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
511 $xact->patron($patron);
512 $xact->sip_currency($currency);
513 $xact->fee_amount($fee_amt);
514 $xact->sip_fee_type($fee_type);
515 $xact->transaction_id($trans_id);
516 $xact->fee_id($fee_id);
517 $xact->sip_payment_type($pay_type);
518 # We don't presently use this, but we might in the future.
519 $xact->patron_password($patron_pwd);
521 $xact->do_fee_payment();
527 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
528 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
529 # my ($patron, $item);
534 # $trans = new ILS::Transaction::Hold;
536 # # BEGIN TRANSACTION
537 # $patron = new ILS::Patron $patron_id;
539 # || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
540 # $trans->screen_msg("Invalid Patron.");
545 # $item = new ILS::Item ($item_id || $title_id);
547 # $trans->screen_msg("No such item.");
549 # # END TRANSACTION (conditionally)
551 # } elsif ($item->fee && ($fee_ack ne 'Y')) {
552 # $trans->screen_msg = "Fee required to place hold.";
554 # # END TRANSACTION (conditionally)
559 # item_id => $item->id,
560 # patron_id => $patron->id,
561 # expiration_date => $expiry_date,
562 # pickup_location => $pickup_location,
563 # hold_type => $hold_type,
567 # $trans->patron($patron);
568 # $trans->item($item);
569 # $trans->pickup_location($pickup_location);
571 # push(@{$item->hold_queue}, $hold);
572 # push(@{$patron->{hold_items}}, $hold);
580 # Note: item_id in this context is the hold id
582 my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
584 my $trans = OpenILS::SIP::Transaction::Hold->new(authtoken => $self->{authtoken});
585 my $patron = $self->find_patron($patron_id);
588 $trans->screen_msg("Invalid patron barcode.");
593 if (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
594 $trans->screen_msg('Invalid patron password.');
599 $trans->patron($patron);
600 my $hold = $patron->find_hold_from_copy($item_id);
603 syslog('LOG_WARNING', "OILS: No hold found from copy $item_id");
604 $trans->screen_msg("No such hold.");
609 if ($hold->usr ne $patron->{user}->id) {
610 $trans->screen_msg("No such hold on patron record.");
616 $trans->do_hold_cancel($self);
618 if ($trans->cancel_ok) {
619 $trans->screen_msg("Hold Cancelled.");
621 $trans->screen_msg("Hold was not cancelled.");
624 # if the hold had no current_copy, use the representative
625 # item as the item for the hold. Without this, the SIP
627 $trans->item($self->find_item($item_id)) unless $trans->item;
633 ## The patron and item id's can't be altered, but the
634 ## date, location, and type can.
636 # my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
637 # $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
638 # my ($patron, $item);
642 # $trans = new ILS::Transaction::Hold;
644 # # BEGIN TRANSACTION
645 # $patron = new ILS::Patron $patron_id;
647 # $trans->screen_msg("Invalid patron barcode.");
652 # foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
653 # $hold = $patron->{hold_items}[$i];
655 # if ($hold->{item_id} eq $item_id) {
656 # # Found it. So fix it.
657 # $hold->{expiration_date} = $expiry_date if $expiry_date;
658 # $hold->{pickup_location} = $pickup_location if $pickup_location;
659 # $hold->{hold_type} = $hold_type if $hold_type;
662 # $trans->screen_msg("Hold updated.");
663 # $trans->patron($patron);
664 # $trans->item(new ILS::Item $hold->{item_id});
669 # # The same hold structure is linked into both the patron's
670 # # list of hold items and into the queue of outstanding holds
671 # # for the item, so we don't need to search the hold queue for
672 # # the item, since it's already been updated by the patron code.
675 # $trans->screen_msg("No such outstanding hold.");
683 my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
684 $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
686 $self->verify_session;
688 my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
689 $trans->patron($self->find_patron($patron_id));
690 $trans->item($self->find_item($item_id));
692 if(!$trans->patron) {
693 $trans->screen_msg("Invalid patron barcode.");
698 if(!$trans->patron->renew_ok) {
699 $trans->screen_msg("Renewals not allowed.");
706 $trans->screen_msg("Title ID renewal not supported. Use item barcode.");
708 $trans->screen_msg("Invalid item barcode.");
714 if(!$trans->item->{patron} or
715 $trans->item->{patron} ne $patron_id) {
716 $trans->screen_msg("Item not checked out to " . $trans->patron->name);
721 # Perform the renewal
724 $trans->desensitize(0); # It's already checked out
725 $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
726 $trans->item->{sip_item_properties} = $item_props if $item_props;
733 my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
735 $self->verify_session;
737 my $trans = OpenILS::SIP::Transaction::RenewAll->new(authtoken => $self->{authtoken});
738 $trans->patron($self->find_patron($patron_id));
740 if(!$trans->patron) {
741 $trans->screen_msg("Invalid patron barcode.");
746 if(!$trans->patron->renew_ok) {
747 $trans->screen_msg("Renewals not allowed.");
752 $trans->do_renew_all($self);
759 # my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
760 # my ($patron, $item_id);
763 # $trans = new ILS::Transaction::RenewAll;
765 # $trans->patron($patron = new ILS::Patron $patron_id);
766 # if (defined $patron) {
767 # syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
768 # $patron->name, $patron->renew_ok);
770 # syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
774 # if (!defined($patron)) {
775 # $trans->screen_msg("Invalid patron barcode.");
777 # } elsif (!$patron->renew_ok) {
778 # $trans->screen_msg("Renewals not allowed.");
780 # } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
781 # $trans->screen_msg("Invalid patron password.");
785 # foreach $item_id (@{$patron->{items}}) {
786 # my $item = new ILS::Item $item_id;
788 # if (!defined($item)) {
789 # syslog("LOG_WARNING",
790 # "renew_all: Invalid item id associated with patron '%s'",
795 # if (@{$item->hold_queue}) {
796 # # Can't renew if there are outstanding holds
797 # push @{$trans->unrenewed}, $item_id;
799 # $item->{due_date} = time + (14*24*60*60); # two weeks hence
800 # push @{$trans->renewed}, $item_id;