use Digest::MD5 qw(md5_hex);
sub new {
- my ($class, $institution, $login) = @_;
- my $type = ref($class) || $class;
- my $self = {};
+ my ($class, $institution, $login) = @_;
+ my $type = ref($class) || $class;
+ my $self = {};
- $self->{login} = $login_account = $login;
+ $self->{login} = $login_account = $login;
- $config = $institution;
- syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
- $self->{institution} = $institution;
+ $config = $institution;
+ syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
+ $self->{institution} = $institution;
- my $bsconfig = $institution->{implementation_config}->{bootstrap};
- $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
+ my $bsconfig = $institution->{implementation_config}->{bootstrap};
+ $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
- syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
+ syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
- # ingress will persist throughout
- OpenSRF::AppSession->ingress('sip2');
-
- local $/ = "\n"; # why?
- OpenSRF::System->bootstrap_client(config_file => $bsconfig);
- syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
+ # ingress will persist throughout
+ OpenSRF::AppSession->ingress('sip2');
+
+ local $/ = "\n"; # why?
+ OpenSRF::System->bootstrap_client(config_file => $bsconfig);
+ syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
- $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
+ $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
- Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
+ Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
- bless( $self, $type );
+ bless( $self, $type );
- return undef unless
- $self->login( $login->{id}, $login->{password} );
+ return undef unless
+ $self->login( $login->{id}, $login->{password} );
- return $self;
+ return $self;
}
sub fetch_session {
my $self = shift;
- my $ses = $U->simplereq(
- 'open-ils.auth',
- 'open-ils.auth.session.retrieve', $self->{authtoken});
+ my $ses = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.session.retrieve', $self->{authtoken});
return undef if $U->event_code($ses); # auth timed out
return $self->{login_session} = $ses;
}
sub verify_session {
- my $self = shift;
+ my $self = shift;
return 1 if $self->fetch_session;
}
sub editor {
- return $editor = make_editor();
+ return $editor = make_editor();
}
sub config {
- return $config;
+ return $config;
}
sub login_account {
- return $login_account;
+ return $login_account;
}
sub get_option_value {
sub make_editor {
OpenILS::Utils::CStoreEditor::init() if $cstore_init;
$cstore_init = 0;
- return OpenILS::Utils::CStoreEditor->new;
+ return OpenILS::Utils::CStoreEditor->new;
}
=head2 clean_text(scalar)
}
sub format_date {
- my $class = shift;
- my $date = shift;
- my $type = shift || 'dob';
-
- return "" unless $date;
-
- $date = DateTime::Format::ISO8601->new->
- parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
- my @time = localtime($date->epoch);
-
- my $year = $time[5]+1900;
- my $mon = $time[4]+1;
- my $day = $time[3];
- my $hour = $time[2];
- my $minute = $time[1];
- my $second = $time[0];
+ my $class = shift;
+ my $date = shift;
+ my $type = shift || 'dob';
+
+ return "" unless $date;
+
+ $date = DateTime::Format::ISO8601->new->
+ parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
+ my @time = localtime($date->epoch);
+
+ my $year = $time[5]+1900;
+ my $mon = $time[4]+1;
+ my $day = $time[3];
+ my $hour = $time[2];
+ my $minute = $time[1];
+ my $second = $time[0];
- $date = sprintf("%04d%02d%02d", $year, $mon, $day);
+ $date = sprintf("%04d%02d%02d", $year, $mon, $day);
- # Due dates need hyphen separators and time of day as well
- if ($type eq 'due') {
- $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
- }
+ # Due dates need hyphen separators and time of day as well
+ if ($type eq 'due') {
+ $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
+ }
- syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
- return $date;
+ syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
+ return $date;
}
sub login {
- my( $self, $username, $password ) = @_;
- syslog('LOG_DEBUG', "OILS: Logging in with username $username");
-
- my $seed = $U->simplereq(
- 'open-ils.auth',
- 'open-ils.auth.authenticate.init', $username );
-
- my $response = $U->simplereq(
- 'open-ils.auth',
- 'open-ils.auth.authenticate.complete',
- {
- username => $username,
- password => md5_hex($seed . md5_hex($password)),
- type => 'opac',
- }
- );
-
- if( my $code = $U->event_code($response) ) {
- my $txt = $response->{textcode};
- syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code");
- return undef;
- }
-
- my $key = $response->{payload}->{authtoken};
- syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
+ my( $self, $username, $password ) = @_;
+ syslog('LOG_DEBUG', "OILS: Logging in with username $username");
+
+ my $seed = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.authenticate.init', $username );
+
+ my $response = $U->simplereq(
+ 'open-ils.auth',
+ 'open-ils.auth.authenticate.complete',
+ {
+ username => $username,
+ password => md5_hex($seed . md5_hex($password)),
+ type => 'opac',
+ }
+ );
+
+ if( my $code = $U->event_code($response) ) {
+ my $txt = $response->{textcode};
+ syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code");
+ return undef;
+ }
+
+ my $key = $response->{payload}->{authtoken};
+ syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
$self->fetch_session; # to cache the login
- return $self->{authtoken} = $key;
+ return $self->{authtoken} = $key;
}
#
# find_patron(usr => $id);
sub find_patron {
- my $self = shift;
+ my $self = shift;
my $key = (@_ > 1) ? shift : 'barcode'; # if we have multiple args, the first is the key index (default barcode)
my $patron_id = shift;
- return OpenILS::SIP::Patron->new($key => $patron_id, authtoken => $self->{authtoken}, @_);
+ return OpenILS::SIP::Patron->new($key => $patron_id, authtoken => $self->{authtoken}, @_);
}
sub find_item {
- my $self = shift;
- return OpenILS::SIP::Item->new(@_);
+ my $self = shift;
+ return OpenILS::SIP::Item->new(@_);
}
}
sub supports {
- my ($self, $op) = @_;
- my ($i) = grep { $_->{name} eq $op }
- @{$config->{implementation_config}->{supports}->{item}};
- return to_bool($i->{value});
+ my ($self, $op) = @_;
+ my ($i) = grep { $_->{name} eq $op }
+ @{$config->{implementation_config}->{supports}->{item}};
+ return to_bool($i->{value});
}
sub check_inst_id {
}
sub checkout_ok {
- return to_bool($config->{policy}->{checkout});
+ return to_bool($config->{policy}->{checkout});
}
sub checkin_ok {
- return to_bool($config->{policy}->{checkin});
+ return to_bool($config->{policy}->{checkin});
}
sub renew_ok {
- return to_bool($config->{policy}->{renewal});
+ return to_bool($config->{policy}->{renewal});
}
sub status_update_ok {
- return to_bool($config->{policy}->{status_update});
+ return to_bool($config->{policy}->{status_update});
}
sub offline_ok {
- return to_bool($config->{policy}->{offline});
+ return to_bool($config->{policy}->{offline});
}
##
sub checkout {
- my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
- # In order to allow renewals the selfcheck AND the config have to say they are allowed
- $sc_renew = (chr($sc_renew) eq 'Y' && $self->renew_ok());
+ my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_;
+ # In order to allow renewals the selfcheck AND the config have to say they are allowed
+ $sc_renew = (chr($sc_renew) eq 'Y' && $self->renew_ok());
- $self->verify_session;
+ $self->verify_session;
- syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
+ syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
my $patron = $self->find_patron($patron_id);
my $item = $self->find_item($item_id);
- $xact->patron($patron);
- $xact->item($item);
-
- if (!$patron) {
- $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
- return $xact;
- }
-
- if (!$patron->charge_ok) {
- $xact->screen_msg("Patron Blocked");
- return $xact;
- }
-
- if( !$item ) {
- $xact->screen_msg("Invalid Item Barcode: '$item_id'");
- return $xact;
- }
-
- syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
-
- if ($item->{patron} && ($item->{patron} eq $patron_id)) {
- $xact->renew_ok(1); # So that accept/reject responses have the correct value later
- if($sc_renew) {
- syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
- } else {
- syslog('LOG_INFO', "OILS: OpenILS::Checkout appears to be renew, but renewal disallowed...");
- $xact->screen_msg("Renewals not permitted");
- $xact->ok(0);
- return $xact; # Don't attempt later
+ $xact->patron($patron);
+ $xact->item($item);
+
+ if (!$patron) {
+ $xact->screen_msg("Invalid Patron Barcode '$patron_id'");
+ return $xact;
+ }
+
+ if (!$patron->charge_ok) {
+ $xact->screen_msg("Patron Blocked");
+ return $xact;
+ }
+
+ if( !$item ) {
+ $xact->screen_msg("Invalid Item Barcode: '$item_id'");
+ return $xact;
+ }
+
+ syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
+
+ if ($item->{patron} && ($item->{patron} eq $patron_id)) {
+ $xact->renew_ok(1); # So that accept/reject responses have the correct value later
+ if($sc_renew) {
+ syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
+ } else {
+ syslog('LOG_INFO', "OILS: OpenILS::Checkout appears to be renew, but renewal disallowed...");
+ $xact->screen_msg("Renewals not permitted");
+ $xact->ok(0);
+ return $xact; # Don't attempt later
}
- } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
- # I can't deal with this right now
- # XXX check in then check out?
- $xact->screen_msg("Item checked out to another patron");
- $xact->ok(0);
- return $xact; # Don't wipe out the screen message later
- } else {
- $sc_renew = 0;
- }
-
- # Check for fee and $fee_ack. If there is a fee, and $fee_ack
- # is 'Y', we proceed, otherwise we reject the checkout.
- if ($item->fee > 0.0) {
- $xact->fee_amount($item->fee);
- $xact->sip_fee_type($item->sip_fee_type);
- $xact->sip_currency($item->fee_currency);
- if ($fee_ack && $fee_ack eq 'Y') {
- $xact->fee_ack(1);
- } else {
- $xact->screen_msg('Fee required');
- $xact->ok(0);
- return $xact;
- }
+ } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
+ # I can't deal with this right now
+ # XXX check in then check out?
+ $xact->screen_msg("Item checked out to another patron");
+ $xact->ok(0);
+ return $xact; # Don't wipe out the screen message later
+ } else {
+ $sc_renew = 0;
+ }
+
+ # Check for fee and $fee_ack. If there is a fee, and $fee_ack
+ # is 'Y', we proceed, otherwise we reject the checkout.
+ if ($item->fee > 0.0) {
+ $xact->fee_amount($item->fee);
+ $xact->sip_fee_type($item->sip_fee_type);
+ $xact->sip_currency($item->fee_currency);
+ if ($fee_ack && $fee_ack eq 'Y') {
+ $xact->fee_ack(1);
+ } else {
+ $xact->screen_msg('Fee required');
+ $xact->ok(0);
+ return $xact;
}
+ }
- $xact->do_checkout($sc_renew);
- $xact->desensitize(!$item->magnetic);
+ $xact->do_checkout($sc_renew);
+ $xact->desensitize(!$item->magnetic);
- if( $xact->ok ) {
- #editor()->commit;
- syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
- "patron %s checkout %s succeeded", $patron_id, $item_id);
- } else {
- #editor()->xact_rollback;
- syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
- "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
- }
+ if( $xact->ok ) {
+ #editor()->commit;
+ syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
+ "patron %s checkout %s succeeded", $patron_id, $item_id);
+ } else {
+ #editor()->xact_rollback;
+ syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
+ "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
+ }
- return $xact;
+ return $xact;
}
sub checkin {
- my ($self, $item_id, $inst_id, $trans_date, $return_date,
+ my ($self, $item_id, $inst_id, $trans_date, $return_date,
$current_loc, $item_props, $cancel) = @_;
my $start_time = time();
- $self->verify_session;
+ $self->verify_session;
- syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
-
+ syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
+
my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
my $item = OpenILS::SIP::Item->new($item_id);
return $xact;
}
- $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
-
- if ($xact->ok) {
+ $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
+
+ if ($xact->ok) {
$xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
delete $item->{patron};
delete $item->{due_date};
}
syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
- return $xact;
+ return $xact;
}
## If the ILS caches patron information, this lets it free it up.
sub pay_fee {
my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
- $pay_type, $fee_id, $trans_id, $currency) = @_;
+ $pay_type, $fee_id, $trans_id, $currency) = @_;
$self->verify_session;
#sub add_hold {
# my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
-# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
# my ($patron, $item);
# my $hold;
# my $trans;
# # BEGIN TRANSACTION
# $patron = new ILS::Patron $patron_id;
# if (!$patron
-# || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
-# $trans->screen_msg("Invalid Patron.");
+# || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
+# $trans->screen_msg("Invalid Patron.");
#
-# return $trans;
+# return $trans;
# }
#
# $item = new ILS::Item ($item_id || $title_id);
# if (!$item) {
-# $trans->screen_msg("No such item.");
+# $trans->screen_msg("No such item.");
#
-# # END TRANSACTION (conditionally)
-# return $trans;
+# # END TRANSACTION (conditionally)
+# return $trans;
# } elsif ($item->fee && ($fee_ack ne 'Y')) {
-# $trans->screen_msg = "Fee required to place hold.";
+# $trans->screen_msg = "Fee required to place hold.";
#
-# # END TRANSACTION (conditionally)
-# return $trans;
+# # END TRANSACTION (conditionally)
+# return $trans;
# }
#
# $hold = {
-# item_id => $item->id,
-# patron_id => $patron->id,
-# expiration_date => $expiry_date,
-# pickup_location => $pickup_location,
-# hold_type => $hold_type,
+# item_id => $item->id,
+# patron_id => $patron->id,
+# expiration_date => $expiry_date,
+# pickup_location => $pickup_location,
+# hold_type => $hold_type,
# };
#
# $trans->ok(1);
# # BEGIN TRANSACTION
# $patron = new ILS::Patron $patron_id;
# if (!$patron) {
-# $trans->screen_msg("Invalid patron barcode.");
+# $trans->screen_msg("Invalid patron barcode.");
#
-# return $trans;
+# return $trans;
# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
-# $trans->screen_msg('Invalid patron password.');
+# $trans->screen_msg('Invalid patron password.');
#
-# return $trans;
+# return $trans;
# }
#
# $item = new ILS::Item ($item_id || $title_id);
# if (!$item) {
-# $trans->screen_msg("No such item.");
+# $trans->screen_msg("No such item.");
#
-# # END TRANSACTION (conditionally)
-# return $trans;
+# # END TRANSACTION (conditionally)
+# return $trans;
# }
#
# # Remove the hold from the patron's record first
# $trans->ok($patron->drop_hold($item_id));
#
# if (!$trans->ok) {
-# # We didn't find it on the patron record
-# $trans->screen_msg("No such hold on patron record.");
+# # We didn't find it on the patron record
+# $trans->screen_msg("No such hold on patron record.");
#
-# # END TRANSACTION (conditionally)
-# return $trans;
+# # END TRANSACTION (conditionally)
+# return $trans;
# }
#
# # Now, remove it from the item record. If it was on the patron
# # record but not on the item record, we'll treat that as success.
# foreach my $i (0 .. scalar @{$item->hold_queue}) {
-# $hold = $item->hold_queue->[$i];
+# $hold = $item->hold_queue->[$i];
#
-# if ($hold->{patron_id} eq $patron->id) {
-# # found it: delete it.
-# splice @{$item->hold_queue}, $i, 1;
-# last;
-# }
+# if ($hold->{patron_id} eq $patron->id) {
+# # found it: delete it.
+# splice @{$item->hold_queue}, $i, 1;
+# last;
+# }
# }
#
# $trans->screen_msg("Hold Cancelled.");
## date, location, and type can.
#sub alter_hold {
# my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
-# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
# my ($patron, $item);
# my $hold;
# my $trans;
# # BEGIN TRANSACTION
# $patron = new ILS::Patron $patron_id;
# if (!$patron) {
-# $trans->screen_msg("Invalid patron barcode.");
+# $trans->screen_msg("Invalid patron barcode.");
#
-# return $trans;
+# return $trans;
# }
#
# foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
-# $hold = $patron->{hold_items}[$i];
-#
-# if ($hold->{item_id} eq $item_id) {
-# # Found it. So fix it.
-# $hold->{expiration_date} = $expiry_date if $expiry_date;
-# $hold->{pickup_location} = $pickup_location if $pickup_location;
-# $hold->{hold_type} = $hold_type if $hold_type;
-#
-# $trans->ok(1);
-# $trans->screen_msg("Hold updated.");
-# $trans->patron($patron);
-# $trans->item(new ILS::Item $hold->{item_id});
-# last;
-# }
+# $hold = $patron->{hold_items}[$i];
+#
+# if ($hold->{item_id} eq $item_id) {
+# # Found it. So fix it.
+# $hold->{expiration_date} = $expiry_date if $expiry_date;
+# $hold->{pickup_location} = $pickup_location if $pickup_location;
+# $hold->{hold_type} = $hold_type if $hold_type;
+#
+# $trans->ok(1);
+# $trans->screen_msg("Hold updated.");
+# $trans->patron($patron);
+# $trans->item(new ILS::Item $hold->{item_id});
+# last;
+# }
# }
#
# # The same hold structure is linked into both the patron's
# # the item, since it's already been updated by the patron code.
#
# if (!$trans->ok) {
-# $trans->screen_msg("No such outstanding hold.");
+# $trans->screen_msg("No such outstanding hold.");
# }
#
# return $trans;
sub renew {
- my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
- $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
-
- $self->verify_session;
-
- my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
- $trans->patron($self->find_patron($patron_id));
- $trans->item($self->find_item($item_id));
-
- if(!$trans->patron) {
- $trans->screen_msg("Invalid patron barcode.");
- $trans->ok(0);
- return $trans;
- }
-
- if(!$trans->patron->renew_ok) {
- $trans->screen_msg("Renewals not allowed.");
- $trans->ok(0);
- return $trans;
- }
-
- if(!$trans->item) {
- if( $title_id ) {
- $trans->screen_msg("Title ID renewal not supported. Use item barcode.");
- } else {
- $trans->screen_msg("Invalid item barcode.");
- }
- $trans->ok(0);
- return $trans;
- }
-
- if(!$trans->item->{patron} or
- $trans->item->{patron} ne $patron_id) {
- $trans->screen_msg("Item not checked out to " . $trans->patron->name);
- $trans->ok(0);
- return $trans;
- }
-
- # Perform the renewal
- $trans->do_renew();
-
- $trans->desensitize(0); # It's already checked out
- $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
- $trans->item->{sip_item_properties} = $item_props if $item_props;
-
- return $trans;
+ my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+ $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
+
+ $self->verify_session;
+
+ my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
+ $trans->patron($self->find_patron($patron_id));
+ $trans->item($self->find_item($item_id));
+
+ if(!$trans->patron) {
+ $trans->screen_msg("Invalid patron barcode.");
+ $trans->ok(0);
+ return $trans;
+ }
+
+ if(!$trans->patron->renew_ok) {
+ $trans->screen_msg("Renewals not allowed.");
+ $trans->ok(0);
+ return $trans;
+ }
+
+ if(!$trans->item) {
+ if( $title_id ) {
+ $trans->screen_msg("Title ID renewal not supported. Use item barcode.");
+ } else {
+ $trans->screen_msg("Invalid item barcode.");
+ }
+ $trans->ok(0);
+ return $trans;
+ }
+
+ if(!$trans->item->{patron} or
+ $trans->item->{patron} ne $patron_id) {
+ $trans->screen_msg("Item not checked out to " . $trans->patron->name);
+ $trans->ok(0);
+ return $trans;
+ }
+
+ # Perform the renewal
+ $trans->do_renew();
+
+ $trans->desensitize(0); # It's already checked out
+ $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
+ $trans->item->{sip_item_properties} = $item_props if $item_props;
+
+ return $trans;
}
#
# $trans->patron($patron = new ILS::Patron $patron_id);
# if (defined $patron) {
-# syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
-# $patron->name, $patron->renew_ok);
+# syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
+# $patron->name, $patron->renew_ok);
# } else {
-# syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
-# $patron_id);
+# syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
+# $patron_id);
# }
#
# if (!defined($patron)) {
-# $trans->screen_msg("Invalid patron barcode.");
-# return $trans;
+# $trans->screen_msg("Invalid patron barcode.");
+# return $trans;
# } elsif (!$patron->renew_ok) {
-# $trans->screen_msg("Renewals not allowed.");
-# return $trans;
+# $trans->screen_msg("Renewals not allowed.");
+# return $trans;
# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
-# $trans->screen_msg("Invalid patron password.");
-# return $trans;
+# $trans->screen_msg("Invalid patron password.");
+# return $trans;
# }
#
# foreach $item_id (@{$patron->{items}}) {
-# my $item = new ILS::Item $item_id;
-#
-# if (!defined($item)) {
-# syslog("LOG_WARNING",
-# "renew_all: Invalid item id associated with patron '%s'",
-# $patron->id);
-# next;
-# }
-#
-# if (@{$item->hold_queue}) {
-# # Can't renew if there are outstanding holds
-# push @{$trans->unrenewed}, $item_id;
-# } else {
-# $item->{due_date} = time + (14*24*60*60); # two weeks hence
-# push @{$trans->renewed}, $item_id;
-# }
+# my $item = new ILS::Item $item_id;
+#
+# if (!defined($item)) {
+# syslog("LOG_WARNING",
+# "renew_all: Invalid item id associated with patron '%s'",
+# $patron->id);
+# next;
+# }
+#
+# if (@{$item->hold_queue}) {
+# # Can't renew if there are outstanding holds
+# push @{$trans->unrenewed}, $item_id;
+# } else {
+# $item->{due_date} = time + (14*24*60*60); # two weeks hence
+# push @{$trans->renewed}, $item_id;
+# }
# }
#
# $trans->ok(1);
$user = $card->usr;
} else {
- $user = $e->retrieve_actor_user([$patron_id, $usr_flesh]);
+ $user = $e->retrieve_actor_user([$patron_id, $usr_flesh]);
}
if(!$user or $U->is_true($user->deleted)) {
sub home_library {
my $self = shift;
my $lib = OpenILS::SIP::shortname_from_id($self->{user}->home_ou);
- syslog('LOG_DEBUG', "OILS: Patron->home_library() = $lib");
+ syslog('LOG_DEBUG', "OILS: Patron->home_library() = $lib");
return $lib;
}
}
sub address {
- my $self = shift;
- my $u = $self->{user};
- my $str = __addr_string($u->billing_address || $u->mailing_address);
- syslog('LOG_DEBUG', "OILS: Patron address: $str");
- return $str;
+ my $self = shift;
+ my $u = $self->{user};
+ my $str = __addr_string($u->billing_address || $u->mailing_address);
+ syslog('LOG_DEBUG', "OILS: Patron address: $str");
+ return $str;
}
sub email_addr {
}
sub sip_birthdate {
- my $self = shift;
- my $dob = OpenILS::SIP->format_date($self->{user}->dob);
- syslog('LOG_DEBUG', "OILS: Patron DOB = $dob");
- return $dob;
+ my $self = shift;
+ my $dob = OpenILS::SIP->format_date($self->{user}->dob);
+ syslog('LOG_DEBUG', "OILS: Patron DOB = $dob");
+ return $dob;
}
sub sip_expire {
sub ptype {
my $self = shift;
- my $use_code = OpenILS::SIP->get_option_value('patron_type_uses_code') || '';
+ my $use_code = OpenILS::SIP->get_option_value('patron_type_uses_code') || '';
# should we use the no_i18n version of patron profile name (as a 'code')?
return $self->{editor}->retrieve_permission_grp_tree(
}
sub check_password {
- my ($self, $pwd) = @_;
- syslog('LOG_DEBUG', 'OILS: Patron->check_password()');
+ my ($self, $pwd) = @_;
+ syslog('LOG_DEBUG', 'OILS: Patron->check_password()');
return 0 unless (defined $pwd and $self->{user});
- return md5_hex($pwd) eq $self->{user}->passwd;
+ return md5_hex($pwd) eq $self->{user}->passwd;
}
sub currency { # not really implemented
- my $self = shift;
- syslog('LOG_DEBUG', 'OILS: Patron->currency()');
- return 'USD';
+ my $self = shift;
+ syslog('LOG_DEBUG', 'OILS: Patron->currency()');
+ return 'USD';
}
sub fee_amount {
- my $self = shift;
- syslog('LOG_DEBUG', 'OILS: Patron->fee_amount()');
+ my $self = shift;
+ syslog('LOG_DEBUG', 'OILS: Patron->fee_amount()');
my $user_id = $self->{user}->id;
my $e = $self->{editor};
$e->rollback; # xact_rollback + disconnect
my $total = ($summary) ? $summary->balance_owed : 0;
- syslog('LOG_INFO', "User ".$self->{id} .":$user_id has a fee amount of \$$total");
- return $total;
+ syslog('LOG_INFO', "User ".$self->{id} .":$user_id has a fee amount of \$$total");
+ return $total;
}
sub screen_msg {
- my $self = shift;
- my $u = $self->{user};
+ my $self = shift;
+ my $u = $self->{user};
- return 'barred' if $u->barred eq 't';
+ return 'barred' if $u->barred eq 't';
- my $b = 'blocked';
+ my $b = 'blocked';
- return $b if $u->active eq 'f';
- return $b if $u->card->active eq 'f';
+ return $b if $u->active eq 'f';
+ return $b if $u->card->active eq 'f';
# if we have any penalties at this point, they are blocking penalties
return $b if $u->standing_penalties and @{$u->standing_penalties};
# has the patron account expired?
- my $expire = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($u->expire_date));
- return $b if CORE::time > $expire->epoch;
+ my $expire = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($u->expire_date));
+ return $b if CORE::time > $expire->epoch;
- return 'OK';
+ return 'OK';
}
sub print_line { # not implemented
my $self = shift;
- return '';
+ return '';
}
sub too_many_charged { # not implemented
my $self = shift;
- return 0;
+ return 0;
}
sub too_many_overdue {
- my $self = shift;
+ my $self = shift;
return scalar( # PATRON_EXCEEDS_OVERDUE_COUNT
grep { $_->standing_penalty == 2 } @{$self->{user}->standing_penalties}
);
# Until someone suggests otherwise, fees and fines are the same
sub excessive_fees {
- my $self = shift;
+ my $self = shift;
return $self->excessive_fines;
}
# not relevant, handled by fines/fees
sub too_many_billed {
my $self = shift;
- return 0;
+ return 0;
}
#
sub hold_items {
my ($self, $start, $end) = @_;
- syslog('LOG_DEBUG', 'OILS: Patron->hold_items()');
+ syslog('LOG_DEBUG', 'OILS: Patron->hold_items()');
- my $holds = $self->{editor}->search_action_hold_request(
- { usr => $self->{user}->id, fulfillment_time => undef, cancel_time => undef }
- );
+ my $holds = $self->{editor}->search_action_hold_request(
+ { usr => $self->{user}->id, fulfillment_time => undef, cancel_time => undef }
+ );
- my @holds;
- push( @holds, OpenILS::SIP::clean_text($self->__hold_to_title($_)) ) for @$holds;
+ my @holds;
+ push( @holds, OpenILS::SIP::clean_text($self->__hold_to_title($_)) ) for @$holds;
- return (defined $start and defined $end) ?
- [ $holds[($start-1)..($end-1)] ] :
- \@holds;
+ return (defined $start and defined $end) ?
+ [ $holds[($start-1)..($end-1)] ] :
+ \@holds;
}
sub __hold_to_title {
- my $self = shift;
- my $hold = shift;
- my $e = $self->{editor};
+ my $self = shift;
+ my $hold = shift;
+ my $e = $self->{editor};
- my( $id, $mods, $title, $volume, $copy );
+ my( $id, $mods, $title, $volume, $copy );
- return __copy_to_title($e,
- $e->retrieve_asset_copy($hold->target))
- if $hold->hold_type eq 'C' or $hold->hold_type eq 'F' or $hold->hold_type eq 'R';
+ return __copy_to_title($e,
+ $e->retrieve_asset_copy($hold->target))
+ if $hold->hold_type eq 'C' or $hold->hold_type eq 'F' or $hold->hold_type eq 'R';
- return __volume_to_title($e,
- $e->retrieve_asset_call_number($hold->target))
- if $hold->hold_type eq 'V';
+ return __volume_to_title($e,
+ $e->retrieve_asset_call_number($hold->target))
+ if $hold->hold_type eq 'V';
- return __record_to_title(
- $e, $hold->target) if $hold->hold_type eq 'T';
+ return __record_to_title(
+ $e, $hold->target) if $hold->hold_type eq 'T';
- return __metarecord_to_title(
- $e, $hold->target) if $hold->hold_type eq 'M';
+ return __metarecord_to_title(
+ $e, $hold->target) if $hold->hold_type eq 'M';
}
sub __copy_to_title {
- my( $e, $copy ) = @_;
- #syslog('LOG_DEBUG', "OILS: copy_to_title(%s)", $copy->id);
- return $copy->dummy_title if $copy->call_number == -1;
+ my( $e, $copy ) = @_;
+ #syslog('LOG_DEBUG', "OILS: copy_to_title(%s)", $copy->id);
+ return $copy->dummy_title if $copy->call_number == -1;
- my $vol = (ref $copy->call_number) ?
- $copy->call_number :
- $e->retrieve_asset_call_number($copy->call_number);
+ my $vol = (ref $copy->call_number) ?
+ $copy->call_number :
+ $e->retrieve_asset_call_number($copy->call_number);
- return __volume_to_title($e, $vol);
+ return __volume_to_title($e, $vol);
}
sub __volume_to_title {
- my( $e, $volume ) = @_;
- #syslog('LOG_DEBUG', "OILS: volume_to_title(%s)", $volume->id);
- return __record_to_title($e, $volume->record);
+ my( $e, $volume ) = @_;
+ #syslog('LOG_DEBUG', "OILS: volume_to_title(%s)", $volume->id);
+ return __record_to_title($e, $volume->record);
}
sub __record_to_title {
- my( $e, $title_id ) = @_;
- #syslog('LOG_DEBUG', "OILS: record_to_title($title_id)");
- my $mods = $U->simplereq(
- 'open-ils.search',
- 'open-ils.search.biblio.record.mods_slim.retrieve', $title_id );
- return ($mods) ? $mods->title : "";
+ my( $e, $title_id ) = @_;
+ #syslog('LOG_DEBUG', "OILS: record_to_title($title_id)");
+ my $mods = $U->simplereq(
+ 'open-ils.search',
+ 'open-ils.search.biblio.record.mods_slim.retrieve', $title_id );
+ return ($mods) ? $mods->title : "";
}
sub __metarecord_to_title {
- my( $e, $m_id ) = @_;
- #syslog('LOG_DEBUG', "OILS: metarecord_to_title($m_id)");
- my $mods = $U->simplereq(
- 'open-ils.search',
- 'open-ils.search.biblio.metarecord.mods_slim.retrieve', $m_id);
- return ($U->event_code($mods)) ? "<unknown>" : $mods->title;
+ my( $e, $m_id ) = @_;
+ #syslog('LOG_DEBUG', "OILS: metarecord_to_title($m_id)");
+ my $mods = $U->simplereq(
+ 'open-ils.search',
+ 'open-ils.search.biblio.metarecord.mods_slim.retrieve', $m_id);
+ return ($U->event_code($mods)) ? "<unknown>" : $mods->title;
}
}
sub __patron_items_info {
- my $self = shift;
- return if $self->{item_info};
- $self->{item_info} =
- OpenILS::Application::Actor::_checked_out(
- 0, $self->{editor}, $self->{user}->id);;
+ my $self = shift;
+ return if $self->{item_info};
+ $self->{item_info} =
+ OpenILS::Application::Actor::_checked_out(
+ 0, $self->{editor}, $self->{user}->id);;
}
sub overdue_items {
- my ($self, $start, $end) = @_;
+ my ($self, $start, $end) = @_;
- $self->__patron_items_info();
- my @overdues = @{$self->{item_info}->{overdue}};
- #$overdues[$_] = __circ_to_title($self->{editor}, $overdues[$_]) for @overdues;
+ $self->__patron_items_info();
+ my @overdues = @{$self->{item_info}->{overdue}};
+ #$overdues[$_] = __circ_to_title($self->{editor}, $overdues[$_]) for @overdues;
- my @o;
- syslog('LOG_DEBUG', "OILS: overdue_items() fleshing circs @overdues");
+ my @o;
+ syslog('LOG_DEBUG', "OILS: overdue_items() fleshing circs @overdues");
- my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
-
- for my $circid (@overdues) {
- next unless $circid;
- if($return_datatype eq 'barcode') {
- push( @o, __circ_to_barcode($self->{editor}, $circid));
- } else {
- push( @o, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
- }
- }
- @overdues = @o;
+ my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
+
+ for my $circid (@overdues) {
+ next unless $circid;
+ if($return_datatype eq 'barcode') {
+ push( @o, __circ_to_barcode($self->{editor}, $circid));
+ } else {
+ push( @o, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
+ }
+ }
+ @overdues = @o;
- return (defined $start and defined $end) ?
- [ $overdues[($start-1)..($end-1)] ] : \@overdues;
+ return (defined $start and defined $end) ?
+ [ $overdues[($start-1)..($end-1)] ] : \@overdues;
}
sub __circ_to_barcode {
- my ($e, $circ) = @_;
- return unless $circ;
- $circ = $e->retrieve_action_circulation($circ);
- my $copy = $e->retrieve_asset_copy($circ->target_copy);
- return $copy->barcode;
+ my ($e, $circ) = @_;
+ return unless $circ;
+ $circ = $e->retrieve_action_circulation($circ);
+ my $copy = $e->retrieve_asset_copy($circ->target_copy);
+ return $copy->barcode;
}
sub __circ_to_title {
- my( $e, $circ ) = @_;
- return unless $circ;
- $circ = $e->retrieve_action_circulation($circ);
- return __copy_to_title( $e,
- $e->retrieve_asset_copy($circ->target_copy) );
+ my( $e, $circ ) = @_;
+ return unless $circ;
+ $circ = $e->retrieve_action_circulation($circ);
+ return __copy_to_title( $e,
+ $e->retrieve_asset_copy($circ->target_copy) );
}
sub charged_items {
- my ($self, $start, $end) = shift;
+ my ($self, $start, $end) = shift;
- $self->__patron_items_info();
+ $self->__patron_items_info();
- my @charges = (
- @{$self->{item_info}->{out}},
- @{$self->{item_info}->{overdue}}
- );
+ my @charges = (
+ @{$self->{item_info}->{out}},
+ @{$self->{item_info}->{overdue}}
+ );
- #$charges[$_] = __circ_to_title($self->{editor}, $charges[$_]) for @charges;
+ #$charges[$_] = __circ_to_title($self->{editor}, $charges[$_]) for @charges;
- my @c;
- syslog('LOG_DEBUG', "OILS: charged_items() fleshing circs @charges");
+ my @c;
+ syslog('LOG_DEBUG', "OILS: charged_items() fleshing circs @charges");
- my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
+ my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
- for my $circid (@charges) {
- next unless $circid;
- if($return_datatype eq 'barcode') {
- push( @c, __circ_to_barcode($self->{editor}, $circid));
- } else {
- push( @c, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
- }
- }
+ for my $circid (@charges) {
+ next unless $circid;
+ if($return_datatype eq 'barcode') {
+ push( @c, __circ_to_barcode($self->{editor}, $circid));
+ } else {
+ push( @c, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
+ }
+ }
- @charges = @c;
+ @charges = @c;
- return (defined $start and defined $end) ?
- [ $charges[($start-1)..($end-1)] ] :
- \@charges;
+ return (defined $start and defined $end) ?
+ [ $charges[($start-1)..($end-1)] ] :
+ \@charges;
}
sub fine_items {
- my ($self, $start, $end) = @_;
- my @fines;
+ my ($self, $start, $end) = @_;
+ my @fines;
eval {
- my $xacts = $U->simplereq('open-ils.actor', 'open-ils.actor.user.transactions.history.have_balance', $self->{authtoken}, $self->{user}->id);
- foreach my $xact (@{$xacts}) {
- my $line = $xact->balance_owed . " " . $xact->last_billing_type . " ";
- if ($xact->xact_type eq 'circulation') {
- my $mods = $U->simplereq('open-ils.circ', 'open-ils.circ.circ_transaction.find_title', $self->{authtoken}, $xact->id);
- $line .= $mods->title . ' / ' . $mods->author;
- } else {
- $line .= $xact->last_billing_note;
- }
- push @fines, OpenILS::SIP::clean_text($line);
+ my $xacts = $U->simplereq('open-ils.actor', 'open-ils.actor.user.transactions.history.have_balance', $self->{authtoken}, $self->{user}->id);
+ foreach my $xact (@{$xacts}) {
+ my $line = $xact->balance_owed . " " . $xact->last_billing_type . " ";
+ if ($xact->xact_type eq 'circulation') {
+ my $mods = $U->simplereq('open-ils.circ', 'open-ils.circ.circ_transaction.find_title', $self->{authtoken}, $xact->id);
+ $line .= $mods->title . ' / ' . $mods->author;
+ } else {
+ $line .= $xact->last_billing_note;
}
+ push @fines, OpenILS::SIP::clean_text($line);
+ }
};
my $log_status = $@ ? 'ERROR: ' . $@ : 'OK';
- syslog('LOG_DEBUG', 'OILS: Patron->fine_items() ' . $log_status);
- return (defined $start and defined $end) ?
- [ $fines[($start-1)..($end-1)] ] : \@fines;
+ syslog('LOG_DEBUG', 'OILS: Patron->fine_items() ' . $log_status);
+ return (defined $start and defined $end) ?
+ [ $fines[($start-1)..($end-1)] ] : \@fines;
}
# not currently supported
}
sub block {
- my ($self, $card_retained, $blocked_card_msg) = @_;
+ my ($self, $card_retained, $blocked_card_msg) = @_;
$blocked_card_msg ||= '';
my $e = $self->{editor};
- my $u = $self->{user};
+ my $u = $self->{user};
- syslog('LOG_INFO', "OILS: Blocking user %s", $u->card->barcode );
+ syslog('LOG_INFO', "OILS: Blocking user %s", $u->card->barcode );
- return $self if $u->card->active eq 'f';
+ return $self if $u->card->active eq 'f';
$e->xact_begin; # connect and start a new transaction
- $u->card->active('f');
- if( ! $e->update_actor_card($u->card) ) {
- syslog('LOG_ERR', "OILS: Block card update failed: %s", $e->event->{textcode});
- $e->rollback; # rollback + disconnect
- return $self;
- }
-
- # retrieve the un-fleshed user object for update
- $u = $e->retrieve_actor_user($u->id);
- my $note = OpenILS::SIP::clean_text($u->alert_message) || "";
- $note = "<sip> CARD BLOCKED BY SELF-CHECK MACHINE. $blocked_card_msg</sip>\n$note"; # XXX Config option
+ $u->card->active('f');
+ if( ! $e->update_actor_card($u->card) ) {
+ syslog('LOG_ERR', "OILS: Block card update failed: %s", $e->event->{textcode});
+ $e->rollback; # rollback + disconnect
+ return $self;
+ }
+
+ # retrieve the un-fleshed user object for update
+ $u = $e->retrieve_actor_user($u->id);
+ my $note = OpenILS::SIP::clean_text($u->alert_message) || "";
+ $note = "<sip> CARD BLOCKED BY SELF-CHECK MACHINE. $blocked_card_msg</sip>\n$note"; # XXX Config option
$note =~ s/\s*$//; # kill trailng whitespace
- $u->alert_message($note);
+ $u->alert_message($note);
- if( ! $e->update_actor_user($u) ) {
- syslog('LOG_ERR', "OILS: Block: patron alert update failed: %s", $e->event->{textcode});
- $e->rollback; # rollback + disconnect
- return $self;
- }
+ if( ! $e->update_actor_user($u) ) {
+ syslog('LOG_ERR', "OILS: Block: patron alert update failed: %s", $e->event->{textcode});
+ $e->rollback; # rollback + disconnect
+ return $self;
+ }
- # stay in synch
- $self->{user}->alert_message( $note );
+ # stay in synch
+ $self->{user}->alert_message( $note );
- $e->commit; # commits and disconnects
- return $self;
+ $e->commit; # commits and disconnects
+ return $self;
}
# Testing purposes only
sub extra_fields {
my( $self ) = @_;
my $extra_fields = {};
- my $u = $self->{user};
+ my $u = $self->{user};
foreach my $stat_cat_entry (@{$u->stat_cat_entries}) {
my $stat_cat = $stat_cat_entry->stat_cat;
next unless ($stat_cat->sip_field);