Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

1634 lines (1407 sloc) 53.386 kb
#
# Sip::MsgType.pm
#
# A Class for handing SIP messages
#
package Sip::MsgType;
use strict;
use warnings;
use Exporter;
use Sys::Syslog qw(syslog);
use Sip qw(:all);
use Sip::Constants qw(:all);
use Sip::Checksum qw(verify_cksum);
use Data::Dumper;
use CGI;
use Koha;
use C4::Context;
use C4::Auth qw(&check_api_auth);
use C4::Biblio;
use C4::Items qw(GetItem);
use UNIVERSAL qw(can); # make sure this is *after* C4 modules.
use vars qw(@ISA $VERSION @EXPORT_OK);
BEGIN {
$VERSION = 1.01;
@ISA = qw(Exporter);
@EXPORT_OK = qw(handle);
}
C4::Context->database_paranoia_mode(1); # guard against a stale dbh from C4::Context.
# Predeclare handler subroutines
use subs qw(handle_patron_status handle_checkout handle_checkin
handle_block_patron handle_sc_status handle_request_acs_resend
handle_login handle_patron_info handle_end_patron_session
handle_fee_paid handle_item_information handle_item_status_update
handle_patron_enable handle_hold handle_renew handle_renew_all);
#
# For the most part, Version 2.00 of the protocol just adds new
# variable fields, but sometimes it changes the fixed header.
#
# In general, if there's no '2.00' protocol entry for a handler, that's
# because 2.00 didn't extend the 1.00 version of the protocol. This will
# be handled by the module initialization code following the declaration,
# which goes through the handlers table and creates a '2.00' entry that
# points to the same place as the '1.00' entry. If there's a 2.00 entry
# but no 1.00 entry, then that means that it's a completely new service
# in 2.00, so 1.00 shouldn't recognize it.
my %handlers = (
(PATRON_STATUS_REQ) => {
name => "Patron Status Request",
handler => \&handle_patron_status,
protocol => {
1 => {
template => "A3A18",
template_len => 21,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_TERMINAL_PWD), (FID_PATRON_PWD)],
}
}
},
(CHECKOUT) => {
name => "Checkout",
handler => \&handle_checkout,
protocol => {
1 => {
template => "CCA18A18",
template_len => 38,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_ITEM_ID), (FID_TERMINAL_PWD)],
},
2 => {
template => "CCA18A18",
template_len => 38,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_ITEM_ID), (FID_TERMINAL_PWD),
(FID_ITEM_PROPS), (FID_PATRON_PWD),
(FID_FEE_ACK), (FID_CANCEL)],
},
}
},
(CHECKIN) => {
name => "Checkin",
handler => \&handle_checkin,
protocol => {
1 => {
template => "CA18A18",
template_len => 37,
fields => [(FID_CURRENT_LOCN), (FID_INST_ID),
(FID_ITEM_ID), (FID_TERMINAL_PWD)],
},
2 => {
template => "CA18A18",
template_len => 37,
fields => [(FID_CURRENT_LOCN), (FID_INST_ID),
(FID_ITEM_ID), (FID_TERMINAL_PWD),
(FID_ITEM_PROPS), (FID_CANCEL)],
}
}
},
(BLOCK_PATRON) => {
name => "Block Patron",
handler => \&handle_block_patron,
protocol => {
1 => {
template => "CA18",
template_len => 19,
fields => [(FID_INST_ID), (FID_BLOCKED_CARD_MSG),
(FID_PATRON_ID), (FID_TERMINAL_PWD)],
},
}
},
(SC_STATUS) => {
name => "SC Status",
handler => \&handle_sc_status,
protocol => {
1 => {
template =>"CA3A4",
template_len => 8,
fields => [],
}
}
},
(REQUEST_ACS_RESEND) => {
name => "Request ACS Resend",
handler => \&handle_request_acs_resend,
protocol => {
1 => {
template => "",
template_len => 0,
fields => [],
}
}
},
(LOGIN) => {
name => "Login",
handler => \&handle_login,
protocol => {
2 => {
template => "A1A1",
template_len => 2,
fields => [(FID_LOGIN_UID), (FID_LOGIN_PWD),
(FID_LOCATION_CODE)],
}
}
},
(PATRON_INFO) => {
name => "Patron Info",
handler => \&handle_patron_info,
protocol => {
2 => {
template => "A3A18A10",
template_len => 31,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_TERMINAL_PWD), (FID_PATRON_PWD),
(FID_START_ITEM), (FID_END_ITEM)],
}
}
},
(END_PATRON_SESSION) => {
name => "End Patron Session",
handler => \&handle_end_patron_session,
protocol => {
2 => {
template => "A18",
template_len => 18,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_TERMINAL_PWD), (FID_PATRON_PWD)],
}
}
},
(FEE_PAID) => {
name => "Fee Paid",
handler => \&handle_fee_paid,
protocol => {
2 => {
template => "A18A2A2A3",
template_len => 25,
fields => [(FID_FEE_AMT), (FID_INST_ID),
(FID_PATRON_ID), (FID_TERMINAL_PWD),
(FID_PATRON_PWD), (FID_FEE_ID),
(FID_TRANSACTION_ID)],
}
}
},
(ITEM_INFORMATION) => {
name => "Item Information",
handler => \&handle_item_information,
protocol => {
2 => {
template => "A18",
template_len => 18,
fields => [(FID_INST_ID), (FID_ITEM_ID),
(FID_TERMINAL_PWD)],
}
}
},
(ITEM_STATUS_UPDATE) => {
name => "Item Status Update",
handler => \&handle_item_status_update,
protocol => {
2 => {
template => "A18",
template_len => 18,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_ITEM_ID), (FID_TERMINAL_PWD),
(FID_ITEM_PROPS)],
}
}
},
(PATRON_ENABLE) => {
name => "Patron Enable",
handler => \&handle_patron_enable,
protocol => {
2 => {
template => "A18",
template_len => 18,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_TERMINAL_PWD), (FID_PATRON_PWD)],
}
}
},
(HOLD) => {
name => "Hold",
handler => \&handle_hold,
protocol => {
2 => {
template => "AA18",
template_len => 19,
fields => [(FID_EXPIRATION), (FID_PICKUP_LOCN),
(FID_HOLD_TYPE), (FID_INST_ID),
(FID_PATRON_ID), (FID_PATRON_PWD),
(FID_ITEM_ID), (FID_TITLE_ID),
(FID_TERMINAL_PWD), (FID_FEE_ACK)],
}
}
},
(RENEW) => {
name => "Renew",
handler => \&handle_renew,
protocol => {
2 => {
template => "CCA18A18",
template_len => 38,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_PATRON_PWD), (FID_ITEM_ID),
(FID_TITLE_ID), (FID_TERMINAL_PWD),
(FID_ITEM_PROPS), (FID_FEE_ACK)],
}
}
},
(RENEW_ALL) => {
name => "Renew All",
handler => \&handle_renew_all,
protocol => {
2 => {
template => "A18",
template_len => 18,
fields => [(FID_INST_ID), (FID_PATRON_ID),
(FID_PATRON_PWD), (FID_TERMINAL_PWD),
(FID_FEE_ACK)],
}
}
}
);
#
# Now, initialize some of the missing bits of %handlers
#
foreach my $i (keys(%handlers)) {
if (!exists($handlers{$i}->{protocol}->{2})) {
$handlers{$i}->{protocol}->{2} = $handlers{$i}->{protocol}->{1};
}
}
sub new {
my ($class, $msg, $seqno) = @_;
my $self = {};
my $msgtag = substr($msg, 0, 2);
if ($msgtag eq LOGIN) {
# If the client is using the 2.00-style "Login" message
# to authenticate to the server, then we get the Login message
# _before_ the client has indicated that it supports 2.00, but
# it's using the 2.00 login process, so it must support 2.00.
$protocol_version = 2;
}
syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s",
$class, substr($msg, 0, 10), $msgtag, $seqno, $protocol_version);
# warn "SIP PROTOCOL: $protocol_version";
if (!exists($handlers{$msgtag})) {
syslog("LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'",
$msgtag, $msg);
return(undef);
} elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) {
syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
$msgtag, $protocol_version);
return(undef);
}
bless $self, $class;
$self->{seqno} = $seqno;
$self->_initialize(substr($msg,2), $handlers{$msgtag});
return($self);
}
sub _initialize {
my ($self, $msg, $control_block) = @_;
my ($fs, $fn, $fe);
my $proto = $control_block->{protocol}->{$protocol_version};
$self->{name} = $control_block->{name};
$self->{handler} = $control_block->{handler};
$self->{fields} = {};
$self->{fixed_fields} = [];
chomp($msg); # These four are probably unnecessary now.
$msg =~ tr/\cM//d;
$msg =~ s/\^M$//;
chomp($msg);
foreach my $field (@{$proto->{fields}}) {
$self->{fields}->{$field} = undef;
}
syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)",
$self->{name}, $msg, $proto->{template}, $proto->{template_len});
$self->{fixed_fields} = [ unpack($proto->{template}, $msg) ]; # see http://perldoc.perl.org/5.8.8/functions/unpack.html
# Skip over the fixed fields and the split the rest of
# the message into fields based on the delimiter and parse them
foreach my $field (split(quotemeta($field_delimiter), substr($msg, $proto->{template_len}))) {
$fn = substr($field, 0, 2);
if (!exists($self->{fields}->{$fn})) {
syslog("LOG_WARNING", "Unsupported field '%s' in %s message '%s'",
$fn, $self->{name}, $msg);
} elsif (defined($self->{fields}->{$fn})) {
syslog("LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'",
$fn, $self->{fields}->{$fn}, $self->{name}, $msg);
} else {
$self->{fields}->{$fn} = substr($field, 2);
}
}
return($self);
}
sub handle {
my ($msg, $server, $req) = @_;
my $config = $server->{config};
my $self;
#
# What's the field delimiter for variable length fields?
# This can't be based on the account, since we need to know
# the field delimiter to parse a SIP login message
#
if (defined($server->{config}->{delimiter})) {
$field_delimiter = $server->{config}->{delimiter};
}
# error detection is active if this is a REQUEST_ACS_RESEND
# message with a checksum, or if the message is long enough
# and the last nine characters begin with a sequence number
# field
if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
# Special case
$error_detection = 1;
$self = new Sip::MsgType ((REQUEST_ACS_RESEND), 0);
} elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
$error_detection = 1;
if (!verify_cksum($msg)) {
syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg);
# REQUEST_SC_RESEND with error detection
$last_response = REQUEST_SC_RESEND_CKSUM;
print("$last_response\r");
return REQUEST_ACS_RESEND;
} else {
# Save the sequence number, then strip off the
# error detection data to process the message
$self = new Sip::MsgType (substr($msg, 0, -9), substr($msg, -7, 1));
}
} elsif ($error_detection) {
# We received a non-ED message when ED is supposed to be active.
# Warn about this problem, then process the message anyway.
syslog("LOG_WARNING",
"Received message without error detection: '%s'", $msg);
$error_detection = 0;
$self = new Sip::MsgType ($msg, 0);
} else {
$self = new Sip::MsgType ($msg, 0);
}
if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
$req && (substr($msg, 0, 2) ne $req)) {
return substr($msg, 0, 2);
}
unless ($self->{handler}) {
syslog("LOG_WARNING", "No handler defined for '%s'", $msg);
return undef;
}
return($self->{handler}->($self, $server)); # FIXME
# FIXME: Use of uninitialized value in subroutine entry
# Can't use string ("") as a subroutine ref while "strict refs" in use
}
##
## Message Handlers
##
#
# Patron status messages are produced in response to both
# "Request Patron Status" and "Block Patron"
#
# Request Patron Status requires a patron password, but
# Block Patron doesn't (since the patron may never have
# provided one before attempting some illegal action).
#
# ASSUMPTION: If the patron password field is present in the
# message, then it must match, otherwise incomplete patron status
# information will be returned to the terminal.
#
sub build_patron_status {
my ($patron, $lang, $fields)= @_;
my $patron_pwd = $fields->{(FID_PATRON_PWD)};
my $resp = (PATRON_STATUS_RESP);
if ($patron) {
$resp .= patron_status_string($patron);
$resp .= $lang . Sip::timestamp();
$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
# while the patron ID we got from the SC is valid, let's
# use the one returned from the ILS, just in case...
$resp .= add_field(FID_PATRON_ID, $patron->id);
if ($protocol_version >= 2) {
$resp .= add_field(FID_VALID_PATRON, 'Y');
# Patron password is a required field.
$resp .= add_field(FID_VALID_PATRON_PWD, sipbool($patron->check_password($patron_pwd)));
$resp .= maybe_add(FID_CURRENCY, $patron->currency);
$resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount);
}
$resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
} else {
# Invalid patron id. Report that the user has no privs.,
# no personal name, and is invalid (if we're using 2.00)
$resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
$resp .= add_field(FID_PERSONAL_NAME, '');
# the patron ID is invalid, but it's a required field, so
# just echo it back
$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
($protocol_version >= 2) and
$resp .= add_field(FID_VALID_PATRON, 'N');
}
$resp .= add_field(FID_INST_ID, $fields->{(FID_INST_ID)});
return $resp;
}
sub handle_patron_status {
my ($self, $server) = @_;
my $ils = $server->{ils};
my $patron;
my $resp = (PATRON_STATUS_RESP);
my $account = $server->{account};
my ($lang, $date) = @{$self->{fixed_fields}};
my $fields = $self->{fields};
#warn Dumper($fields);
#warn FID_INST_ID;
#warn $fields->{(FID_INST_ID)};
$ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_patron_status");
$patron = $ils->find_patron($fields->{(FID_PATRON_ID)});
$resp = build_patron_status($patron, $lang, $fields);
$self->write_msg($resp);
return (PATRON_STATUS_REQ);
}
sub handle_checkout {
my ($self, $server) = @_;
my $account = $server->{account};
my $ils = $server->{ils};
my $inst = $ils->institution;
my ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date);
my $fields;
my ($patron_id, $item_id, $status);
my ($item, $patron);
my $resp;
($sc_renewal_policy, $no_block, $trans_date, $nb_due_date) =
@{$self->{fixed_fields}};
$fields = $self->{fields};
$patron_id = $fields->{(FID_PATRON_ID)};
$item_id = $fields->{(FID_ITEM_ID)};
if ($no_block eq 'Y') {
# Off-line transactions need to be recorded, but there's
# not a lot we can do about it
syslog("LOG_WARNING", "received no-block checkout from terminal '%s'",
$account->{id});
$status = $ils->checkout_no_block($patron_id, $item_id,
$sc_renewal_policy,
$trans_date, $nb_due_date);
} else {
# Does the transaction date really matter for items that are
# checkout out while the terminal is online? I'm guessing 'no'
$status = $ils->checkout($patron_id, $item_id, $sc_renewal_policy);
}
$item = $status->item;
$patron = $status->patron;
if ($status->ok) {
# Item successfully checked out
# Fixed fields
$resp = CHECKOUT_RESP . '1';
$resp .= sipbool($status->renew_ok);
if ($ils->supports('magnetic media')) {
$resp .= sipbool($item->magnetic_media);
} else {
$resp .= 'U';
}
# We never return the obsolete 'U' value for 'desensitize'
$resp .= sipbool($status->desensitize);
$resp .= Sip::timestamp;
# Now for the variable fields
$resp .= add_field(FID_INST_ID, $inst);
$resp .= add_field(FID_PATRON_ID, $patron_id);
$resp .= add_field(FID_ITEM_ID, $item_id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
$resp .= add_field(FID_DUE_DATE, $item->due_date);
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
if ($protocol_version >= 2) {
if ($ils->supports('security inhibit')) {
$resp .= add_field(FID_SECURITY_INHIBIT,
$status->security_inhibit);
}
$resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type);
$resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
# Financials
if ($status->fee_amount) {
$resp .= add_field(FID_FEE_AMT, $status->fee_amount);
$resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
$resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
$resp .= maybe_add(FID_TRANSACTION_ID,
$status->transaction_id);
}
}
} else {
# Checkout failed
# Checkout Response: not ok, no renewal, don't know mag. media,
# no desensitize
$resp = sprintf("120NUN%s", Sip::timestamp);
$resp .= add_field(FID_INST_ID, $inst);
$resp .= add_field(FID_PATRON_ID, $patron_id);
$resp .= add_field(FID_ITEM_ID, $item_id);
# If the item is valid, provide the title, otherwise
# leave it blank
$resp .= add_field(FID_TITLE_ID, $item ? $item->title_id : '');
# Due date is required. Since it didn't get checked out,
# it's not due, so leave the date blank
if (defined $item && defined $item->due_date) {
$resp .= add_field(FID_DUE_DATE, $item->due_date);
} else {
$resp .= add_field(FID_DUE_DATE, '');
}
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
if ($protocol_version >= 2) {
# Is the patron ID valid?
$resp .= add_field(FID_VALID_PATRON, sipbool($patron));
if ($patron && exists($fields->{FID_PATRON_PWD})) {
# Password provided, so we can tell if it was valid or not
$resp .= add_field(FID_VALID_PATRON_PWD,
sipbool($patron->check_password($fields->{(FID_PATRON_PWD)})));
}
}
}
$self->write_msg($resp);
return(CHECKOUT);
}
sub handle_checkin {
my ($self, $server) = @_;
my $account = $server->{account};
my $ils = $server->{ils};
my ($current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel);
my ($patron, $item, $status);
my $resp = CHECKIN_RESP;
my $hold_patron_id;
my ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}};
my $fields = $self->{fields};
$current_loc = $fields->{(FID_CURRENT_LOCN)};
$inst_id = $fields->{(FID_INST_ID)};
$item_id = $fields->{(FID_ITEM_ID)};
$item_props = $fields->{(FID_ITEM_PROPS)};
$cancel = $fields->{(FID_CANCEL)};
$ils->check_inst_id($inst_id, "handle_checkin");
if ($no_block eq 'Y') {
# Off-line transactions, ick.
syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
$status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
} else {
$status = $ils->checkin($item_id, $trans_date, $return_date, $current_loc, $item_props, $cancel);
}
$patron = $status->patron;
$item = $status->item;
$resp .= $status->ok ? '1' : '0';
$resp .= $status->resensitize ? 'Y' : 'N';
if ($item && $ils->supports('magnetic media')) {
$resp .= sipbool($item->magnetic_media);
} else {
# item barcode is invalid or system doesn't support 'magnetic media' indicator
$resp .= 'U';
}
# apparently we can't trust the returns from Checkin yet (because C4::Circulation::AddReturn is faulty)
# So we reproduce the alert logic here.
if (not $status->alert) {
if ($item->hold_patron_id) {
$status->alert(1);
if ($item->destination_loc and $item->destination_loc ne $current_loc) {
$status->alert_type('02'); # hold at other library
# If item is already in transit to another branch, do not alert
if ($status->{hold}->{found} eq 'T') {
$status->alert(0);
$status->alert_type(undef);
}
} else {
$status->alert_type('01'); # hold at this library
}
} elsif ($item->destination_loc and $item->destination_loc ne $current_loc) {
$status->alert(1);
$status->alert_type('04'); # no hold, just send it
}
}
$resp .= $status->alert ? 'Y' : 'N';
$resp .= Sip::timestamp;
$resp .= add_field(FID_INST_ID, $inst_id);
$resp .= add_field(FID_ITEM_ID, $item_id);
$hold_patron_id = $status->{hold}->{borrowernumber};
if ($item) {
$resp .= add_field(FID_PERM_LOCN, $item->permanent_location);
$resp .= maybe_add(FID_TITLE_ID, $item->title_id);
}
if ($protocol_version >= 2) {
$resp .= maybe_add(FID_SORT_BIN, $status->sort_bin);
if ($patron) {
$resp .= add_field(FID_PATRON_ID, $patron->id);
}
if ($item) {
$resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type );
$resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
$resp .= maybe_add(FID_COLLECTION_CODE, $item->collection_code );
$resp .= maybe_add(FID_CALL_NUMBER, $item->call_number );
$resp .= maybe_add(FID_DESTINATION_LOCATION, $item->destination_loc );
$resp .= maybe_add(FID_HOLD_PATRON_ID, $item->hold_patron_bcode($hold_patron_id) );
$resp .= maybe_add(FID_HOLD_PATRON_NAME, $item->hold_patron_name($hold_patron_id) );
if ($status->hold and $status->hold->{branchcode} ne $item->destination_loc) {
warn 'SIP hold mismatch: $status->hold->{branchcode}=' . $status->hold->{branchcode} . '; $item->destination_loc=' . $item->destination_loc;
# just me being paranoid.
}
}
}
$resp .= maybe_add(FID_ALERT_TYPE, $status->alert_type) if $status->alert;
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(CHECKIN);
}
sub handle_block_patron {
my ($self, $server) = @_;
my $account = $server->{account};
my $ils = $server->{ils};
my ($card_retained, $trans_date);
my ($inst_id, $blocked_card_msg, $patron_id, $terminal_pwd);
my ($fields,$resp,$patron);
($card_retained, $trans_date) = @{$self->{fixed_fields}};
$fields = $self->{fields};
$inst_id = $fields->{(FID_INST_ID)};
$blocked_card_msg = $fields->{(FID_BLOCKED_CARD_MSG)};
$patron_id = $fields->{(FID_PATRON_ID)};
$terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
# Terminal passwords are different from account login
# passwords, but I have no idea what to do with them. So,
# I'll just ignore them for now.
# FIXME ???
$ils->check_inst_id($inst_id, "block_patron");
$patron = $ils->find_patron($patron_id);
# The correct response for a "Block Patron" message is a
# "Patron Status Response", so use that handler to generate
# the message, but then return the correct code from here.
#
# Normally, the language is provided by the "Patron Status"
# fixed field, but since we're not responding to one of those
# we'll just say, "Unspecified", as per the spec. Let the
# terminal default to something that, one hopes, will be
# intelligible
if ($patron) {
# Valid patron id
$patron->block($card_retained, $blocked_card_msg);
}
$resp = build_patron_status($patron, $patron->language, $fields);
$self->write_msg($resp);
return(BLOCK_PATRON);
}
sub handle_sc_status {
my ($self, $server) = @_;
($server) or warn "handle_sc_status error: no \$server argument received.";
my ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}};
my ($new_proto);
if ($sc_protocol_version =~ /^1\./) {
$new_proto = 1;
} elsif ($sc_protocol_version =~ /^2\./) {
$new_proto = 2;
} else {
syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
$new_proto = 1;
}
if ($new_proto != $protocol_version) {
syslog("LOG_INFO", "Setting protocol level to $new_proto");
$protocol_version = $new_proto;
}
if ($status == SC_STATUS_PAPER) {
syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
$self->{account}->{id}, $self->{account}->{institution});
} elsif ($status == SC_STATUS_SHUTDOWN) {
syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
$self->{account}->{id}, $self->{account}->{institution});
}
$self->{account}->{print_width} = $print_width;
return (send_acs_status($self, $server) ? SC_STATUS : '');
}
sub handle_request_acs_resend {
my ($self, $server) = @_;
if (!$last_response) {
# We haven't sent anything yet, so respond with a
# REQUEST_SC_RESEND msg (p. 16)
$self->write_msg(REQUEST_SC_RESEND);
} elsif ((length($last_response) < 9)
|| substr($last_response, -9, 2) ne 'AY') {
# When resending a message, we aren't supposed to include
# a sequence number, even if the original had one (p. 4).
# If the last message didn't have a sequence number, then
# we can just send it.
print("$last_response\r"); # not write_msg?
} else {
# Cut out the sequence number and checksum, since the old
# checksum is wrong for the resent message.
my $rebuilt = substr($last_response, 0, -9);
$self->write_msg($rebuilt);
}
return REQUEST_ACS_RESEND;
}
sub login_core ($$$) {
my $server = shift or return undef;
my $uid = shift;
my $pwd = shift;
my $status = 1; # Assume it all works
if (!exists($server->{config}->{accounts}->{$uid})) {
syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'");
$status = 0;
} elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'");
$status = 0;
} else {
# Store the active account someplace handy for everybody else to find.
$server->{account} = $server->{config}->{accounts}->{$uid};
my $inst = $server->{account}->{institution};
$server->{institution} = $server->{config}->{institutions}->{$inst};
$server->{policy} = $server->{institution}->{policy};
$server->{sip_username} = $uid;
$server->{sip_password} = $pwd;
my $auth_status = api_auth($uid,$pwd);
if (!$auth_status or $auth_status !~ /^ok$/i) {
syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s",
$uid, $inst, ($auth_status||'unknown'));
$status = 0;
} else {
syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst);
#
# initialize connection to ILS
#
my $module = $server->{config}->{institutions}->{$inst}->{implementation};
syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
$module->use;
if ($@) {
syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
$server->{service}, $module, $inst);
die("Failed to load ILS implementation '$module' for $inst");
}
# like ILS->new(), I think.
$server->{ils} = $module->new($server->{institution}, $server->{account});
if (!$server->{ils}) {
syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
die("Unable to connect to ILS '$inst'");
}
}
}
return $status;
}
sub handle_login {
my ($self, $server) = @_;
my ($uid_algorithm, $pwd_algorithm);
my ($uid, $pwd);
my $inst;
my $fields;
my $status = 1; # Assume it all works
$fields = $self->{fields};
($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}};
$uid = $fields->{(FID_LOGIN_UID)}; # Terminal ID, not patron ID.
$pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD.
if ($uid_algorithm || $pwd_algorithm) {
syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm");
$status = 0;
}
else { $status = login_core($server,$uid,$pwd); }
$self->write_msg(LOGIN_RESP . $status);
return $status ? LOGIN : '';
}
#
# Build the detailed summary information for the Patron
# Information Response message based on the first 'Y' that appears
# in the 'summary' field of the Patron Information reqest. The
# specification says that only one 'Y' can appear in that field,
# and we're going to believe it.
#
sub summary_info {
my ($ils, $patron, $summary, $start, $end) = @_;
my $resp = '';
my $summary_type;
#
# Map from offsets in the "summary" field of the Patron Information
# message to the corresponding field and handler
#
my @summary_map = (
{ func => $patron->can( "hold_items"), fid => FID_HOLD_ITEMS },
{ func => $patron->can("overdue_items"), fid => FID_OVERDUE_ITEMS },
{ func => $patron->can("charged_items"), fid => FID_CHARGED_ITEMS },
{ func => $patron->can( "fine_items"), fid => FID_FINE_ITEMS },
{ func => $patron->can( "recall_items"), fid => FID_RECALL_ITEMS },
{ func => $patron->can("unavail_holds"), fid => FID_UNAVAILABLE_HOLD_ITEMS },
);
if (($summary_type = index($summary, 'Y')) == -1) {
return ''; # No detailed information required
}
syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
$summary_type, $summary_map[$summary_type]->{fid});
my $func = $summary_map[$summary_type]->{func};
my $fid = $summary_map[$summary_type]->{fid};
my $itemlist = &$func($patron, $start, $end);
syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
foreach my $i (@{$itemlist}) {
my $bibitem = GetBiblioFromItemNumber($i->{itemnumber});
if (C4::Context->preference('SIPItemDisplay') eq "barcode\+title") {
my $bctitle = $bibitem->{barcode} . " " . $bibitem->{title};
$resp .= add_field($fid, $bctitle);
}
else {
$resp .= add_field($fid, $bibitem->{barcode});
}
}
return $resp;
}
sub handle_patron_info {
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($lang, $trans_date, $summary) = @{$self->{fixed_fields}};
my $fields = $self->{fields};
my ($inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end);
my ($resp, $patron, $count);
$inst_id = $fields->{(FID_INST_ID)};
$patron_id = $fields->{(FID_PATRON_ID)};
$terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
$patron_pwd = $fields->{(FID_PATRON_PWD)};
$start = $fields->{(FID_START_ITEM)};
$end = $fields->{(FID_END_ITEM)};
$patron = $ils->find_patron($patron_id);
$resp = (PATRON_INFO_RESP);
if ($patron) {
$resp .= patron_status_string($patron);
$resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
$resp .= Sip::timestamp();
$resp .= add_count('patron_info/hold_items',
scalar @{$patron->hold_items});
$resp .= add_count('patron_info/overdue_items',
scalar @{$patron->overdue_items});
$resp .= add_count('patron_info/charged_items',
scalar @{$patron->charged_items});
$resp .= add_count('patron_info/fine_items',
scalar @{$patron->fine_items});
$resp .= add_count('patron_info/recall_items',
scalar @{$patron->recall_items});
$resp .= add_count('patron_info/unavail_holds',
scalar @{$patron->unavail_holds});
# FID_INST_ID added last (order irrelevant for fields w/ identifiers)
# while the patron ID we got from the SC is valid, let's
# use the one returned from the ILS, just in case...
$resp .= add_field(FID_PATRON_ID, $patron->id);
$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
# TODO: add code for the fields
# hold items limit
# overdue items limit
# charged items limit
$resp .= add_field(FID_VALID_PATRON, 'Y');
if (defined($patron_pwd)) {
# If patron password was provided, report whether it was right or not.
$resp .= add_field(FID_VALID_PATRON_PWD,
sipbool($patron->check_password($patron_pwd)));
}
$resp .= maybe_add(FID_CURRENCY, $patron->currency);
$resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount);
$resp .= add_field(FID_FEE_LMT, $patron->fee_limit);
# TODO: zero or more item details for 2.0 can go here:
# hold_items
# overdue_items
# charged_items
# fine_items
# recall_items
$resp .= summary_info($ils, $patron, $summary, $start, $end);
$resp .= maybe_add(FID_HOME_ADDR, $patron->address);
$resp .= maybe_add(FID_EMAIL, $patron->email_addr);
$resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
# SIP 2.0 extensions used by Envisionware
# Other terminals will ignore unrecognized fields (unrecognized field identifiers)
$resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->birthdate);
$resp .= maybe_add(FID_PATRON_CLASS, $patron->ptype);
# Custom protocol extension to report patron internet privileges
$resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
$resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
} else {
# Invalid patron ID:
# no privileges, no items associated,
# no personal name, and is invalid (if we're using 2.00)
$resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
$resp .= '0000' x 6;
# patron ID is invalid, but field is required, so just echo it back
$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
$resp .= add_field(FID_PERSONAL_NAME, '');
if ($protocol_version >= 2) {
$resp .= add_field(FID_VALID_PATRON, 'N');
}
}
if (C4::Context->preference('UsePatronBranchForPatronInfo')) {
$resp .= add_field(FID_INST_ID, ($patron->{branchcode} || 'SIP2'));
}
else {
$resp .= add_field(FID_INST_ID, ($ils->institution_id || 'SIP2'));
}
$self->write_msg($resp);
return(PATRON_INFO);
}
sub handle_end_patron_session {
my ($self, $server) = @_;
my $ils = $server->{ils};
my $trans_date;
my $fields = $self->{fields};
my $resp = END_SESSION_RESP;
my ($status, $screen_msg, $print_line);
($trans_date) = @{$self->{fixed_fields}};
$ils->check_inst_id($fields->{(FID_INST_ID)}, 'handle_end_patron_session');
($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
$resp .= $status ? 'Y' : 'N';
$resp .= Sip::timestamp();
$resp .= add_field(FID_INST_ID, $server->{ils}->institution);
$resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
$resp .= maybe_add(FID_SCREEN_MSG, $screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $print_line);
$self->write_msg($resp);
return(END_PATRON_SESSION);
}
sub handle_fee_paid {
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($trans_date, $fee_type, $pay_type, $currency) = $self->{fixed_fields};
my $fields = $self->{fields};
my ($fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd);
my ($fee_id, $trans_id);
my $status;
my $resp = FEE_PAID_RESP;
$fee_amt = $fields->{(FID_FEE_AMT)};
$inst_id = $fields->{(FID_INST_ID)};
$patron_id = $fields->{(FID_PATRON_ID)};
$patron_pwd = $fields->{(FID_PATRON_PWD)};
$fee_id = $fields->{(FID_FEE_ID)};
$trans_id = $fields->{(FID_TRANSACTION_ID)};
$ils->check_inst_id($inst_id, "handle_fee_paid");
$status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
$pay_type, $fee_id, $trans_id, $currency);
$resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;
$resp .= add_field(FID_INST_ID, $inst_id);
$resp .= add_field(FID_PATRON_ID, $patron_id);
$resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(FEE_PAID);
}
sub handle_item_information {
my ($self, $server) = @_;
my $ils = $server->{ils};
my $trans_date;
my $fields = $self->{fields};
my $resp = ITEM_INFO_RESP;
my $item;
my $i;
($trans_date) = @{$self->{fixed_fields}};
$ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_item_information");
$item = $ils->find_item($fields->{(FID_ITEM_ID)});
if (!defined($item)) {
# Invalid Item ID
# "Other" circ stat, "Other" security marker, "Unknown" fee type
$resp .= "010101";
$resp .= Sip::timestamp;
# Just echo back the invalid item id
$resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
# title id is required, but we don't have one
$resp .= add_field(FID_TITLE_ID, '');
} else {
# Valid Item ID, send the good stuff
$resp .= $item->sip_circulation_status;
$resp .= $item->sip_security_marker;
$resp .= $item->sip_fee_type;
$resp .= Sip::timestamp;
$resp .= add_field(FID_ITEM_ID, $item->id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
$resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type);
$resp .= maybe_add(FID_PERM_LOCN, $item->permanent_location);
$resp .= maybe_add(FID_CURRENT_LOCN, $item->current_location);
$resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
if (($i = $item->fee) != 0) {
$resp .= add_field(FID_CURRENCY, $item->fee_currency);
$resp .= add_field(FID_FEE_AMT, $i);
}
$resp .= maybe_add(FID_OWNER, $item->owner);
if (($i = scalar @{$item->hold_queue}) > 0) {
$resp .= add_field(FID_HOLD_QUEUE_LEN, $i);
}
if (($i = $item->due_date) != 0) {
$i .= " 000000";
$resp .= add_field(FID_DUE_DATE, $i);
}
if (($i = $item->recall_date) != 0) {
$resp .= add_field(FID_RECALL_DATE, Sip::timestamp($i));
}
if (($i = $item->hold_pickup_date) != 0) {
$resp .= add_field(FID_HOLD_PICKUP_DATE, Sip::timestamp($i));
}
$resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $item->print_line);
}
$self->write_msg($resp);
return(ITEM_INFORMATION);
}
sub handle_item_status_update {
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($trans_date, $item_id, $terminal_pwd, $item_props);
my $fields = $self->{fields};
my $status;
my $item;
my $resp = ITEM_STATUS_UPDATE_RESP;
($trans_date) = @{$self->{fixed_fields}};
$ils->check_inst_id($fields->{(FID_INST_ID)});
$item_id = $fields->{(FID_ITEM_ID)};
$item_props = $fields->{(FID_ITEM_PROPS)};
if (!defined($item_id)) {
syslog("LOG_WARNING",
"handle_item_status: received message without Item ID field");
} else {
$item = $ils->find_item($item_id);
}
if (!$item) {
# Invalid Item ID
$resp .= '0';
$resp .= Sip::timestamp;
$resp .= add_field(FID_ITEM_ID, $item_id);
} else {
# Valid Item ID
$status = $item->status_update($item_props);
$resp .= $status->ok ? '1' : '0';
$resp .= Sip::timestamp;
$resp .= add_field(FID_ITEM_ID, $item->id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
$resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
}
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(ITEM_STATUS_UPDATE);
}
sub handle_patron_enable {
my ($self, $server) = @_;
my $ils = $server->{ils};
my $fields = $self->{fields};
my ($trans_date, $patron_id, $terminal_pwd, $patron_pwd);
my ($status, $patron);
my $resp = PATRON_ENABLE_RESP;
($trans_date) = @{$self->{fixed_fields}};
$patron_id = $fields->{(FID_PATRON_ID)};
$patron_pwd = $fields->{(FID_PATRON_PWD)};
syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
$patron_id, $patron_pwd);
$patron = $ils->find_patron($patron_id);
if (!defined($patron)) {
# Invalid patron ID
$resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();
$resp .= add_field(FID_PATRON_ID, $patron_id);
$resp .= add_field(FID_PERSONAL_NAME, '');
$resp .= add_field(FID_VALID_PATRON, 'N');
$resp .= add_field(FID_VALID_PATRON_PWD, 'N');
} else {
# valid patron
if (!defined($patron_pwd) || $patron->check_password($patron_pwd)) {
# Don't enable the patron if there was an invalid password
$status = $patron->enable;
}
$resp .= patron_status_string($patron);
$resp .= $patron->language . Sip::timestamp();
$resp .= add_field(FID_PATRON_ID, $patron->id);
$resp .= add_field(FID_PERSONAL_NAME, $patron->name);
if (defined($patron_pwd)) {
$resp .= add_field(FID_VALID_PATRON_PWD,
sipbool($patron->check_password($patron_pwd)));
}
$resp .= add_field(FID_VALID_PATRON, 'Y');
$resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
}
$resp .= add_field(FID_INST_ID, $ils->institution);
$self->write_msg($resp);
return(PATRON_ENABLE);
}
sub handle_hold {
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($hold_mode, $trans_date);
my ($expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd);
my ($item_id, $title_id, $fee_ack);
my $fields = $self->{fields};
my $status;
my $resp = HOLD_RESP;
($hold_mode, $trans_date) = @{$self->{fixed_fields}};
$ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_hold");
$patron_id = $fields->{(FID_PATRON_ID) };
$expiry_date = $fields->{(FID_EXPIRATION) } || '';
$pickup_locn = $fields->{(FID_PICKUP_LOCN)} || '';
$hold_type = $fields->{(FID_HOLD_TYPE) } || '2'; # Any copy of title
$patron_pwd = $fields->{(FID_PATRON_PWD) };
$item_id = $fields->{(FID_ITEM_ID) } || '';
$title_id = $fields->{(FID_TITLE_ID) } || '';
$fee_ack = $fields->{(FID_FEE_ACK) } || 'N';
if ($hold_mode eq '+') {
$status = $ils->add_hold($patron_id, $patron_pwd, $item_id, $title_id,
$expiry_date, $pickup_locn, $hold_type, $fee_ack);
} elsif ($hold_mode eq '-') {
$status = $ils->cancel_hold($patron_id, $patron_pwd, $item_id, $title_id);
} elsif ($hold_mode eq '*') {
$status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, $title_id,
$expiry_date, $pickup_locn, $hold_type, $fee_ack);
} else {
syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
$hold_mode, $server->{account}->{id});
$status = $ils->Transaction::Hold; # new?
$status->screen_msg("System error. Please contact library staff.");
}
$resp .= $status->ok;
$resp .= sipbool($status->item && $status->item->available($patron_id));
$resp .= Sip::timestamp;
if ($status->ok) {
$resp .= add_field(FID_PATRON_ID, $status->patron->id);
($status->expiration_date) and
$resp .= maybe_add(FID_EXPIRATION,
Sip::timestamp($status->expiration_date));
$resp .= maybe_add(FID_QUEUE_POS, $status->queue_position);
$resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
$resp .= maybe_add(FID_ITEM_ID, $status->item->id);
$resp .= maybe_add(FID_TITLE_ID, $status->item->title_id);
} else {
# Not ok. still need required fields
$resp .= add_field(FID_PATRON_ID, $patron_id);
}
$resp .= add_field(FID_INST_ID, $ils->institution);
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(HOLD);
}
sub handle_renew {
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($third_party, $no_block, $trans_date, $nb_due_date);
my ($patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack);
my $fields = $self->{fields};
my $status;
my $renew_due_date;
my ($patron, $item);
my $resp = RENEW_RESP;
($third_party, $no_block, $trans_date, $nb_due_date) =
@{$self->{fixed_fields}};
$ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
if ($no_block eq 'Y') {
syslog("LOG_WARNING",
"handle_renew: recieved 'no block' renewal from terminal '%s'",
$server->{account}->{id});
}
$patron_id = $fields->{(FID_PATRON_ID)};
$patron_pwd = $fields->{(FID_PATRON_PWD)};
$item_id = $fields->{(FID_ITEM_ID)};
$title_id = $fields->{(FID_TITLE_ID)};
$item_props = $fields->{(FID_ITEM_PROPS)};
$fee_ack = $fields->{(FID_FEE_ACK)};
$status = $ils->renew($patron_id, $patron_pwd, $item_id, $title_id,
$no_block, $nb_due_date, $third_party,
$item_props, $fee_ack);
$patron = $status->patron;
$item = $status->item;
my $renewitem = GetItem($item->{itemnumber});
$renewitem->{onloan} =~ s/-//g;
if ($status->ok) {
$resp .= '1';
$resp .= $status->renewal_ok ? 'Y' : 'N';
if ($ils->supports('magnetic media')) {
$resp .= sipbool($item->magnetic_media);
} else {
$resp .= 'U';
}
$resp .= sipbool($status->desensitize);
$resp .= Sip::timestamp;
$resp .= add_field(FID_PATRON_ID, $patron->id);
$resp .= add_field(FID_ITEM_ID, $item->id);
$resp .= add_field(FID_TITLE_ID, $item->title_id);
$renew_due_date = $renewitem->{onloan} . " 000000";
$resp .= add_field(FID_DUE_DATE, $renew_due_date);
if ($ils->supports('security inhibit')) {
$resp .= add_field(FID_SECURITY_INHIBIT,
$status->security_inhibit);
}
$resp .= add_field(FID_MEDIA_TYPE, $item->sip_media_type);
$resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
} else {
# renew failed for some reason
# not OK, renewal not OK, Unknown media type (why bother checking?)
$resp .= '0NUN';
$resp .= Sip::timestamp;
# If we found the patron or the item, the return the ILS
# information, otherwise echo back the infomation we received
# from the terminal
$resp .= add_field(FID_PATRON_ID, $patron ? $patron->id : $patron_id);
$resp .= add_field(FID_ITEM_ID, $item ? $item->id : $item_id );
$resp .= add_field(FID_TITLE_ID, $item ? $item->title_id : $title_id );
$resp .= add_field(FID_DUE_DATE, '');
}
if ($status->fee_amount) {
$resp .= add_field(FID_FEE_AMT, $status->fee_amount);
$resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
$resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
$resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
}
$resp .= add_field(FID_INST_ID, $ils->institution);
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(RENEW);
}
sub handle_renew_all {
# my ($third_party, $no_block, $nb_due_date, $fee_ack, $patron);
my ($self, $server) = @_;
my $ils = $server->{ils};
my ($trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack);
my $fields = $self->{fields};
my $resp = RENEW_ALL_RESP;
my $status;
my (@renewed, @unrenewed);
$ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew_all");
($trans_date) = @{$self->{fixed_fields}};
$patron_id = $fields->{(FID_PATRON_ID)};
$patron_pwd = $fields->{(FID_PATRON_PWD)};
$terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
$fee_ack = $fields->{(FID_FEE_ACK)};
$status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack);
$resp .= $status->ok ? '1' : '0';
if (!$status->ok) {
$resp .= add_count("renew_all/renewed_count" , 0);
$resp .= add_count("renew_all/unrenewed_count", 0);
@renewed = ();
@unrenewed = ();
} else {
@renewed = (@{$status->renewed});
@unrenewed = (@{$status->unrenewed});
$resp .= add_count("renew_all/renewed_count" , scalar @renewed );
$resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
}
$resp .= Sip::timestamp;
$resp .= add_field(FID_INST_ID, $ils->institution);
$resp .= join('', map(add_field(FID_RENEWED_ITEMS , $_), @renewed ));
$resp .= join('', map(add_field(FID_UNRENEWED_ITEMS, $_), @unrenewed));
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
$resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
$self->write_msg($resp);
return(RENEW_ALL);
}
#
# send_acs_status($self, $server)
#
# Send an ACS Status message, which is contains lots of little fields
# of information gleaned from all sorts of places.
#
my @message_type_names = (
"patron status request",
"checkout",
"checkin",
"block patron",
"acs status",
"request sc/acs resend",
"login",
"patron information",
"end patron session",
"fee paid",
"item information",
"item status update",
"patron enable",
"hold",
"renew",
"renew all",
);
sub send_acs_status {
my ($self, $server, $screen_msg, $print_line) = @_;
my $msg = ACS_STATUS;
($server) or die "send_acs_status error: no \$server argument received";
my $account = $server->{account} or die "send_acs_status error: no 'account' in \$server object:\n" . Dumper($server);
my $policy = $server->{policy} or die "send_acs_status error: no 'policy' in \$server object:\n" . Dumper($server);
my $ils = $server->{ils} or die "send_acs_status error: no 'ils' in \$server object:\n" . Dumper($server);
my ($online_status, $checkin_ok, $checkout_ok, $ACS_renewal_policy);
my ($status_update_ok, $offline_ok, $timeout, $retries);
$online_status = 'Y';
$checkout_ok = sipbool($ils->checkout_ok);
$checkin_ok = sipbool($ils->checkin_ok);
$ACS_renewal_policy = sipbool($policy->{renewal});
$status_update_ok = sipbool($ils->status_update_ok);
$offline_ok = sipbool($ils->offline_ok);
$timeout = sprintf("%03d", $policy->{timeout});
$retries = sprintf("%03d", $policy->{retries});
if (length($timeout) != 3) {
syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'",
$timeout);
$timeout = '000';
}
if (length($retries) != 3) {
syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'",
$retries);
$retries = '000';
}
$msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
$msg .= "$status_update_ok$offline_ok$timeout$retries";
$msg .= Sip::timestamp();
if ($protocol_version == 1) {
$msg .= '1.00';
} elsif ($protocol_version == 2) {
$msg .= '2.00';
} else {
syslog("LOG_ERR",
'Bad setting for $protocol_version, "%s" in send_acs_status',
$protocol_version);
$msg .= '1.00';
}
# Institution ID
$msg .= add_field(FID_INST_ID, $account->{institution});
if ($protocol_version >= 2) {
# Supported messages: we do it all
my $supported_msgs = '';
foreach my $msg_name (@message_type_names) {
if ($msg_name eq 'request sc/acs resend') {
$supported_msgs .= Sip::sipbool(1);
} else {
$supported_msgs .= Sip::sipbool($ils->supports($msg_name));
}
}
if (length($supported_msgs) < 16) {
syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
}
$msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
}
$msg .= maybe_add(FID_SCREEN_MSG, $screen_msg);
if (defined($account->{print_width}) && defined($print_line)
&& $account->{print_width} < length($print_line)) {
syslog("LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating",
$print_line);
$print_line = substr($print_line, 0, $account->{print_width});
}
$msg .= maybe_add(FID_PRINT_LINE, $print_line);
# Do we want to tell the terminal its location?
$self->write_msg($msg);
return 1;
}
#
# build_patron_status: create the 14-char patron status
# string for the Patron Status message
#
sub patron_status_string {
my $patron = shift;
my $patron_status;
syslog("LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok);
$patron_status = sprintf(
'%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
denied($patron->charge_ok),
denied($patron->renew_ok),
denied($patron->recall_ok),
denied($patron->hold_ok),
boolspace($patron->card_lost),
boolspace($patron->too_many_charged),
boolspace($patron->too_many_overdue),
boolspace($patron->too_many_renewal),
boolspace($patron->too_many_claim_return),
boolspace($patron->too_many_lost),
boolspace($patron->excessive_fines),
boolspace($patron->excessive_fees),
boolspace($patron->recall_overdue),
boolspace($patron->too_many_billed)
);
return $patron_status;
}
sub api_auth($$) {
# AUTH
my ($username,$password) = (shift,shift);
$ENV{REMOTE_USER} = $username;
my $query = CGI->new();
$query->param(userid => $username);
$query->param(password => $password);
my ($status, $cookie, $sessionID) = check_api_auth($query, {circulate=>1}, "intranet");
# print STDERR "check_api_auth returns " . ($status || 'undef') . "\n";
# print "api_auth userenv = " . &dump_userenv;
return $status;
}
1;
__END__
Jump to Line
Something went wrong with that request. Please try again.