From 7b9b36bd2e023a57a6da378e174fdf13dbda97b4 Mon Sep 17 00:00:00 2001 From: Ryan Higgins Date: Mon, 5 Nov 2007 17:13:56 -0600 Subject: [PATCH] adding openncip / opensip SIP2 service Signed-off-by: Chris Cormack Signed-off-by: Joshua Ferraro --- C4/SIP/ILS.pm | 498 +++++++ C4/SIP/ILS.pod | 486 +++++++ C4/SIP/ILS/Item.pm | 214 +++ C4/SIP/ILS/Item.pod | 231 ++++ C4/SIP/ILS/Patron.pm | 393 ++++++ C4/SIP/ILS/Patron.pod | 210 +++ C4/SIP/ILS/Transaction.pm | 59 + C4/SIP/ILS/Transaction/Checkin.pm | 42 + C4/SIP/ILS/Transaction/Checkout.pm | 39 + C4/SIP/ILS/Transaction/FeePayment.pm | 12 + C4/SIP/ILS/Transaction/Hold.pm | 39 + C4/SIP/ILS/Transaction/Renew.pm | 33 + C4/SIP/ILS/Transaction/RenewAll.pm | 29 + C4/SIP/Makefile | 26 + C4/SIP/README | 24 + C4/SIP/SIPServer.pm | 273 ++++ C4/SIP/SIPconfig.xml | 55 + C4/SIP/Sip.pm | 188 +++ C4/SIP/Sip/Checksum.pm | 55 + C4/SIP/Sip/Configuration.pm | 105 ++ C4/SIP/Sip/Configuration/Account.pm | 43 + C4/SIP/Sip/Configuration/Institution.pm | 31 + C4/SIP/Sip/Configuration/Service.pm | 25 + C4/SIP/Sip/Constants.pm | 339 +++++ C4/SIP/Sip/MsgType.pm | 1577 +++++++++++++++++++++++ C4/SIP/acstest.py | 42 + C4/SIP/t/00sc_status.t | 26 + C4/SIP/t/01patron_status.t | 80 ++ C4/SIP/t/02patron_info.t | 172 +++ C4/SIP/t/03checkout.t | 209 +++ C4/SIP/t/04patron_status.t | 100 ++ C4/SIP/t/05block_patron.t | 45 + C4/SIP/t/06patron_enable.t | 144 +++ C4/SIP/t/07hold.t | 187 +++ C4/SIP/t/08checkin.t | 67 + C4/SIP/t/09renew.t | 147 +++ C4/SIP/t/10renew_all.t | 107 ++ C4/SIP/t/11item_info.t | 42 + C4/SIP/t/Makefile | 16 + C4/SIP/t/README | 50 + C4/SIP/t/SIPtest.pm | 225 ++++ C4/SIP/test.txt | 17 + C4/SIP/xmlparse.pl | 29 + C4/SIP_openils_pm | 617 +++++++++ 44 files changed, 7348 insertions(+) create mode 100644 C4/SIP/ILS.pm create mode 100644 C4/SIP/ILS.pod create mode 100644 C4/SIP/ILS/Item.pm create mode 100644 C4/SIP/ILS/Item.pod create mode 100644 C4/SIP/ILS/Patron.pm create mode 100644 C4/SIP/ILS/Patron.pod create mode 100644 C4/SIP/ILS/Transaction.pm create mode 100644 C4/SIP/ILS/Transaction/Checkin.pm create mode 100644 C4/SIP/ILS/Transaction/Checkout.pm create mode 100644 C4/SIP/ILS/Transaction/FeePayment.pm create mode 100644 C4/SIP/ILS/Transaction/Hold.pm create mode 100644 C4/SIP/ILS/Transaction/Renew.pm create mode 100644 C4/SIP/ILS/Transaction/RenewAll.pm create mode 100644 C4/SIP/Makefile create mode 100755 C4/SIP/README create mode 100644 C4/SIP/SIPServer.pm create mode 100644 C4/SIP/SIPconfig.xml create mode 100644 C4/SIP/Sip.pm create mode 100644 C4/SIP/Sip/Checksum.pm create mode 100644 C4/SIP/Sip/Configuration.pm create mode 100644 C4/SIP/Sip/Configuration/Account.pm create mode 100644 C4/SIP/Sip/Configuration/Institution.pm create mode 100644 C4/SIP/Sip/Configuration/Service.pm create mode 100644 C4/SIP/Sip/Constants.pm create mode 100644 C4/SIP/Sip/MsgType.pm create mode 100644 C4/SIP/acstest.py create mode 100644 C4/SIP/t/00sc_status.t create mode 100644 C4/SIP/t/01patron_status.t create mode 100644 C4/SIP/t/02patron_info.t create mode 100644 C4/SIP/t/03checkout.t create mode 100644 C4/SIP/t/04patron_status.t create mode 100644 C4/SIP/t/05block_patron.t create mode 100644 C4/SIP/t/06patron_enable.t create mode 100644 C4/SIP/t/07hold.t create mode 100644 C4/SIP/t/08checkin.t create mode 100644 C4/SIP/t/09renew.t create mode 100644 C4/SIP/t/10renew_all.t create mode 100644 C4/SIP/t/11item_info.t create mode 100644 C4/SIP/t/Makefile create mode 100644 C4/SIP/t/README create mode 100644 C4/SIP/t/SIPtest.pm create mode 100644 C4/SIP/test.txt create mode 100644 C4/SIP/xmlparse.pl create mode 100644 C4/SIP_openils_pm diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm new file mode 100644 index 0000000000..20e940ff3b --- /dev/null +++ b/C4/SIP/ILS.pm @@ -0,0 +1,498 @@ +# +# ILS.pm: Test ILS interface module +# + +package ILS; + +use warnings; +use strict; +use Sys::Syslog qw(syslog); + +use ILS::Item; +use ILS::Patron; +use ILS::Transaction; +use ILS::Transaction::Checkout; +use ILS::Transaction::Checkin; +use ILS::Transaction::FeePayment; +use ILS::Transaction::Hold; +use ILS::Transaction::Renew; +use ILS::Transaction::RenewAll; + +my %supports = ( + 'magnetic media' => 0, + 'security inhibit' => 0, + 'offline operation' => 0, + "patron status request" => 1, + "checkout" => 1, + "checkin" => 1, + "block patron" => 1, + "acs status" => 1, + "login" => 1, + "patron information" => 1, + "end patron session" => 1, + "fee paid" => 0, + "item information" => 1, + "item status update" => 0, + "patron enable" => 1, + "hold" => 1, + "renew" => 1, + "renew all" => 0, + ); + +sub new { + my ($class, $institution) = @_; + my $type = ref($class) || $class; + my $self = {}; + + syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id}); + $self->{institution} = $institution; + + return bless $self, $type; +} + +sub find_patron { + my $self = shift; + + return ILS::Patron->new(@_); +} + +sub find_item { + my $self = shift; + + return ILS::Item->new(@_); +} + +sub institution { + my $self = shift; + + return $self->{institution}->{id}; +} + +sub supports { + my ($self, $op) = @_; + + return (exists($supports{$op}) && $supports{$op}); +} + +sub check_inst_id { + my ($self, $id, $whence) = @_; + + if ($id ne $self->{institution}->{id}) { + syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", + $whence, $id, $self->{institution}->{id}); + } +} + +sub to_bool { + my $bool = shift; + + # If it's defined, and matches a true sort of string, or is + # a non-zero number, then it's true. + return defined($bool) && (($bool =~ /true|y|yes/i) || $bool != 0); +} + +sub checkout_ok { + my $self = shift; + + return (exists($self->{policy}->{checkout}) + && to_bool($self->{policy}->{checkout})); +} + +sub checkin_ok { + my $self = shift; + + return (exists($self->{policy}->{checkin}) + && to_bool($self->{policy}->{checkin})); +} + +sub status_update_ok { + my $self = shift; + + return (exists($self->{policy}->{status_update}) + && to_bool($self->{policy}->{status_update})); + +} + +sub offline_ok { + my $self = shift; + + return (exists($self->{policy}->{offline}) + && to_bool($self->{policy}->{offline})); +} + +# +# Checkout(patron_id, item_id, sc_renew): +# patron_id & item_id are the identifiers send by the terminal +# sc_renew is the renewal policy configured on the terminal +# returns a status opject that can be queried for the various bits +# of information that the protocol (SIP or NCIP) needs to generate +# the response. +# +sub checkout { + my ($self, $patron_id, $item_id, $sc_renew) = @_; + my ($patron, $item, $circ); + + $circ = new ILS::Transaction::Checkout; + + # BEGIN TRANSACTION + $circ->patron($patron = new ILS::Patron $patron_id); + $circ->item($item = new ILS::Item $item_id); + + if (!$patron) { + $circ->screen_msg("Invalid Patron"); + } elsif (!$patron->charge_ok) { + $circ->screen_msg("Patron Blocked"); + } elsif (!$item) { + $circ->screen_msg("Invalid Item"); + } elsif (@{$item->hold_queue} && ($patron_id ne $item->hold_queue->[0])) { + $circ->screen_msg("Item on Hold for Another User"); + } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) { + # I can't deal with this right now + $circ->screen_msg("Item checked out to another patron"); + } else { + $circ->ok(1); + # If the item is already associated with this patron, then + # we're renewing it. + $circ->renew_ok($item->{patron} && ($item->{patron} eq $patron_id)); + $item->{patron} = $patron_id; + $item->{due_date} = time + (14*24*60*60); # two weeks + push(@{$patron->{items}}, $item_id); + $circ->desensitize(!$item->magnetic); + + syslog("LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s", + $patron_id, join(', ', @{$patron->{items}})); + } + + # END TRANSACTION + + return $circ; +} + +sub checkin { + my ($self, $item_id, $trans_date, $return_date, + $current_loc, $item_props, $cancel) = @_; + my ($patron, $item, $circ); + + $circ = new ILS::Transaction::Checkin; + # BEGIN TRANSACTION + $circ->item($item = new ILS::Item $item_id); + + # It's ok to check it in if it exists, and if it was checked out + $circ->ok($item && $item->{patron}); + + if ($circ->ok) { + $circ->patron($patron = new ILS::Patron $item->{patron}); + delete $item->{patron}; + delete $item->{due_date}; + $patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ]; + } + # END TRANSACTION + + return $circ; +} + +# If the ILS caches patron information, this lets it free +# it up +sub end_patron_session { + my ($self, $patron_id) = @_; + + # success?, screen_msg, print_line + return (1, 'Thank you for using Evergreen!', ''); +} + +sub pay_fee { + my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type, + $pay_type, $fee_id, $trans_id, $currency) = @_; + my $trans; + my $patron; + + $trans = new ILS::Transaction::FeePayment; + + $patron = new ILS::Patron $patron_id; + + $trans->transaction_id($trans_id); + $trans->patron($patron); + $trans->ok(1); + + return $trans; +} + +sub add_hold { + my ($self, $patron_id, $patron_pwd, $item_id, $title_id, + $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_; + my ($patron, $item); + my $hold; + my $trans; + + + $trans = new ILS::Transaction::Hold; + + # BEGIN TRANSACTION + $patron = new ILS::Patron $patron_id; + if (!$patron + || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) { + $trans->screen_msg("Invalid Patron."); + + return $trans; + } + + $item = new ILS::Item ($item_id || $title_id); + if (!$item) { + $trans->screen_msg("No such item."); + + # END TRANSACTION (conditionally) + return $trans; + } elsif ($item->fee && ($fee_ack ne 'Y')) { + $trans->screen_msg = "Fee required to place hold."; + + # 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, + }; + + $trans->ok(1); + $trans->patron($patron); + $trans->item($item); + $trans->pickup_location($pickup_location); + + push(@{$item->hold_queue}, $hold); + push(@{$patron->{hold_items}}, $hold); + + + # END TRANSACTION + return $trans; +} + +sub cancel_hold { + my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_; + my ($patron, $item, $hold); + my $trans; + + $trans = new ILS::Transaction::Hold; + + # BEGIN TRANSACTION + $patron = new ILS::Patron $patron_id; + if (!$patron) { + $trans->screen_msg("Invalid patron barcode."); + + return $trans; + } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { + $trans->screen_msg('Invalid patron password.'); + + return $trans; + } + + $item = new ILS::Item ($item_id || $title_id); + if (!$item) { + $trans->screen_msg("No such item."); + + # 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."); + + # 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]; + + if ($hold->{patron_id} eq $patron->id) { + # found it: delete it. + splice @{$item->hold_queue}, $i, 1; + last; + } + } + + $trans->screen_msg("Hold Cancelled."); + $trans->patron($patron); + $trans->item($item); + + return $trans; +} + + +# The patron and item id's can't be altered, but the +# 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) = @_; + my ($patron, $item); + my $hold; + my $trans; + + $trans = new ILS::Transaction::Hold; + + # BEGIN TRANSACTION + $patron = new ILS::Patron $patron_id; + if (!$patron) { + $trans->screen_msg("Invalid patron barcode."); + + 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; + } + } + + # The same hold structure is linked into both the patron's + # list of hold items and into the queue of outstanding holds + # for the item, so we don't need to search the hold queue for + # the item, since it's already been updated by the patron code. + + if (!$trans->ok) { + $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) = @_; + my ($patron, $item); + my $trans; + + $trans = new ILS::Transaction::Renew; + + $trans->patron($patron = new ILS::Patron $patron_id); + + if (!$patron) { + $trans->screen_msg("Invalid patron barcode."); + + return $trans; + } elsif (!$patron->renew_ok) { + $trans->screen_msg("Renewals not allowed."); + + return $trans; + } + + if (defined($title_id)) { + # renewing a title, rather than an item (sort of) + # This is gross, but in a real ILS it would be better + foreach my $i (@{$patron->{items}}) { + $item = new ILS::Item $i; + last if ($title_id eq $item->title_id); + $item = undef; + } + } else { + foreach my $i (@{$patron->{items}}) { + if ($i == $item_id) { + # We have it checked out + $item = new ILS::Item $item_id; + last; + } + } + } + + $trans->item($item); + + if (!defined($item)) { + # It's not checked out to $patron_id + $trans->screen_msg("Item not checked out to " . $patron->name); + } elsif (!$item->available($patron_id)) { + $trans->screen_msg("Item has outstanding holds"); + } else { + $trans->renewal_ok(1); + + $trans->desensitize(0); # It's already checked out + + if ($no_block eq 'Y') { + $item->{due_date} = $nb_due_date; + } else { + $item->{due_date} = time + (14*24*60*60); # two weeks + } + if ($item_props) { + $item->{sip_item_properties} = $item_props; + } + $trans->ok(1); + $trans->renewal_ok(1); + + return $trans; + } + + return $trans; +} + +sub renew_all { + my ($self, $patron_id, $patron_pwd, $fee_ack) = @_; + my ($patron, $item_id); + my $trans; + + $trans = new ILS::Transaction::RenewAll; + + $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); + } else { + syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", + $patron_id); + } + + if (!defined($patron)) { + $trans->screen_msg("Invalid patron barcode."); + return $trans; + } elsif (!$patron->renew_ok) { + $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; + } + + 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; + } + } + + $trans->ok(1); + + return $trans; +} + +1; diff --git a/C4/SIP/ILS.pod b/C4/SIP/ILS.pod new file mode 100644 index 0000000000..8ff3b46bc5 --- /dev/null +++ b/C4/SIP/ILS.pod @@ -0,0 +1,486 @@ +=head1 NAME + +ILS - Portability layer to interface between Open-SIP and ILS + +=head1 SYNOPSIS + + use ILS; + + # Initialize connection between SIP and the ILS + my $ils = new ILS (institution => 'Foo Public Library'); + + # Basic object access methods + $inst_name = $self->institution; + $bool = $self->support($operation); + $self->check_inst_id($inst_name, "error message"); + + # Check to see if certain protocol options are permitted + $bool = $self->checkout_ok; + $bool = $self->checkin_ok; + $bool = $self->status_update_ok; + $bool = $self->offline_ok; + + $status = $ils->checkout($patron_id, $item_id, $sc_renew); + + $status = $ils->checkin($item_id, $trans_date, $return_date, + $current_loc, $item_props, $cancel); + + $status = $ils->end_patron_session($patron_id); + + $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, + $fee_type, $pay_type, $fee_id, $trans_id, + $currency); + + $status = $ils->add_hold($patron_id, $patron_pwd, $item_id, + $title_id, $expiry_date, + $pickup_locn, $hold_type, $fee_ack); + + $status = $ils->cancel_hold($patron_id, $patron_pwd, + $item_id, $title_id); + + $status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, + $title_id, $expiry_date, + $pickup_locn, $hold_type, + $fee_ack); + + $status = $ils->renew($patron_id, $patron_pwd, $item_id, + $title_id, $no_block, $nb_due_date, + $third_party, $item_props, $fee_ack); + + $status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack); + +=head1 INTRODUCTION + +The ILS module defines a basic portability layer between the SIP +server and the rest of the integrated library system. It is the +responsibility of the ILS vendor to implement the functions +defined by this interface. This allows the SIP server to be +reasonably portable between ILS systems (of course, we won't know +exactly I portable the interface is until it's been used by +a second ILS. + +Because no business logic is embedded in the SIP server code +itself, the SIP protocol handler functions do almost nothing +except decode the network messages and pass the parameters to the +ILS module or one of its submodules, C and +C. The SIP protocol query messages (Patron +Information, or Item Status, for example), are implemented within +the SIP server code by fetching a Patron, or Item, record and +then retrieving the relevant information from that record. See +L and L for the details. + +=head1 INITIALIZATION + +The first thing the SIP server does, after a terminal has +successfully logged in, is initialize the ILS module by calling + + $ils = new ILS $institution + +where C<$institution> is an object of type +C, describing the institution to +which the terminal belongs. In general, this will be the single +institution that the ILS supports, but it may be that in a +consortial setting, the SIP server may support connecting to +different ILSs based on the C<$institution> of the terminal. + +=head1 BASIC OBJECT ACCESS AND PROTOCOL SUPPORT + +The C<$ils> object supports a small set of simple access methods +and methods that allow the SIP server to determine if certain +protocol operations are permitted to the remote terminals. + +=head2 C<$inst_name = $self-Einstitution;> + +Returns the institution ID as a string, suitable for +incorporating into a SIP response message. + +=head2 C<$bool = $self-Esupport($operation);> + +Reports whether this ILS implementation supports certain +operations that are necessary to report information to the SIP +terminal. The argument C<$operation> is a string from this list: + +=over + +=item C<'magnetic media'> + +Can the ILS properly report whether an item is (or contains) +magnetic media, such as a videotape or a book with a floppy disk? + +=item C<'security inhibit'> + +Is the ILS capable of directing the terminal to ignore the +security status of an item? + +=item C<'offline operation'> + +Does the ILS allow self-check units to operate when unconnected +to the ILS? That is, can a self-check unit check out items to +patrons without checking the status of the items and patrons in +real time? + +=back + +=head2 C<$bool = $self-Echeckout_ok;> + +Are the self service terminals permitted to check items out to +patrons? + +=head2 C<$bool = $self-Echeckin_ok;> + +Are the self service terminals permitted to check items in? + +=head2 C<$bool = $self-Estatus_update_ok;> + +Are the self service terminals permitted to update patron status +information. For example, can terminals block patrons? + +=head2 C<$bool = $self-Eoffline_ok>; + +Are the self service terminals permitted to operate off-line. +That is, can they perform their core self service operations when +not in communication with the ILS? + +=head1 THE TRANSACTIONS + +In general, every protocol transaction that changes the status of +some ILS object (Patron or Item) has a corresponding C +method. Operations like C, which are a function of +both a patron and an item are C functions, while others, +like C or C, which only depend on one +type of object, are methods of the corresponding sub-module. + +In the stub implementation provided with the SIP system, the +C<$status> objects returned by the various C transactions +are objects that are subclasses of a virtual C +object, but this is not required of the SIP code, as long as the +status objects support the appropriate methods. + +=head2 CORE TRANSACTION STATUS METHODS + +The C<$status> objects returned by all transactions must support +the following common methods: + +=over + +=item C + +Returns C if the transaction was successful and C if +not. Other methods can be used to find out what went wrong. + +=item C + +Returns an C object corresponding to the item with the +barcode C<$item_id>, or C if the barcode is invalid. + +=item C + +Returns a C object corresponding to the patron with +the barcode C<$patron_id>, or C if the barcode is invalid +(ie, nonexistent, as opposed to "expired" or "delinquent"). + +=item C + +Optional. Returns a message that is to be displayed on the +terminal's screen. Some self service terminals read the value of +this string and act based on it. The configuration of the +terminal, and the ILS implementation of this method will have to +be coordinated. + +=item C + +Optional. Returns a message that is to be printed on the +terminal's receipt printer. This message is distinct from the +basic transactional information that the terminal will be +printing anyway (such as, the basic checkout information like the +title and due date). + +=back + +=head2 C<$status = $ils-Echeckout($patron_id, $item_id, $sc_renew)> + +Check out (or possibly renew) item with barcode C<$item_id> to +the patron with barcode C<$patron_id>. If C<$sc_renew> is true, +then the self-check terminal has been configured to allow +self-renewal of items, and the ILS may take this into account +when deciding how to handle the case where C<$item_id> is already +checked out to C<$patron_id>. + +The C<$status> object returned by C must support the +following methods: + +=over + +=item C + +Is this transaction actually a renewal? That is, did C<$patron_id> +already have C<$item_id> checked out? + +=item C + +Should the terminal desensitize the item? This will be false for +magnetic media, like videocassettes, and for "in library" items +that are checked out to the patron, but not permitted to leave the +building. + +=item C + +Should self checkout unit ignore the security status of this +item? + +This method will only be used if + + $ils->supports('security inhibit') + +returns C. + +=item C + +If there is a fee associated with the use of C<$item_id>, then +this method should return the amount of the fee, otherwise it +should return zero. See also the C and +C methods. + +=item C + +The ISO currency code for the currency in which the fee +associated with this item is denominated. For example, 'USD' or +'CAD'. + +=item C + +A code indicating the type of fee associated with this item. See +the table in the protocol specification for the complete list of +standard values that this function can return. + +=back + +=head2 C<$status = $ils-Echeckin($item_id, $trans_date, $return_date, $current_loc, $item_props, $cancel)> + +Check in item identified by barcode C<$item_id>. This +transaction took place at time C<$trans_date> and was effective +C<$return_date> (to allow for backdating of items to when the +branch closed, for example). The self check unit which received +the item is located at C<$current_loc>, and the item has +properties C<$item_props>. The parameters C<$current_loc> and +C<$item_props> are opaque strings passed from the self service +unit to the ILS untranslated. The configuration of the terminal, +and the ILS implementation of this method will have to be +coordinated. + +The C<$status> object returned by the C operation must +support the following methods: + +=over + +=item C + +Does the item need to be resensitized by the self check unit? + +=item C + +Should the self check unit generate an audible alert to notify +staff that the item has been returned? + +=item C + +Certain self checkin units provide for automated sorting of the +returned items. This function returns the bin number into which +the received item should be placed. This function may return the +empty string, or C, to indicate that no sort bin has been +specified. + +=back + +=head2 C<($status, $screen_msg, $print_line) = $ils-Eend_patron_session($patron_id)> + +This function informs the ILS that the current patron's session +has ended. This allows the ILS to free up any internal state +that it may be preserving between messages from the self check +unit. The function returns a boolean C<$status>, where C +indicates success, and two strings: a screen message to display +on the self check unit's console, and a print line to be printed +on the unit's receipt printer. + +=head2 C<$status = $ils-Epay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type, $pay_type, $fee_id, $trans_id, $currency)> + +Reports that the self check terminal handled fee payment from +patron C<$patron_id> (who has password C<$patron_pwd>, which is +an optional parameter). The other parameters are: + +=over + +=item C<$fee_amt> + +The amount of the fee. + +=item C<$fee_type> + +The type of fee, according a table in the SIP protocol +specification. + +=item C<$pay_type> + +The payment method. Defined in the SIP protocol specification. + +=item C<$fee_id> + +Optional. Identifies which particular fee was paid. This +identifier would have been sent from the ILS to the Self Check +unit by a previous "Patron Information Response" message. + +=item C<$trans_id> + +Optional. A transaction identifier set by the payment device. +This should be recorded by the ILS for financial tracking +purposes. + +=item C<$currency> + +An ISO currency code indicating the currency in which the fee was +paid. + +=back + +The status object returned by the C must support the +following methods: + +=over + +=item C + +Transaction identifier of the transaction. This parallels the +optional C<$trans_id> sent from the terminal to the ILS. This +may return an empty string. + +=back + +=head2 C<$status = $ils-Eadd_hold($patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack);> + +Places a hold for C<$patron_id> (optionally, with password +C<$patron_pwd>) on the item described by either C<$item_id> or +C<$title_id>. The other parameters are: + +=over + +=item C<$expiry_date> + +The date on which the hold should be cancelled. This date is a +SIP protocol standard format timestamp: + + YYYYMMDDZZZZHHMMSS + +where the 'Z' characters indicate spaces. + +=item C<$pickup_location> + +The location at which the patron wishes to pick up the item when +it's available. The configuration of the terminal, and the ILS +implementation of this parameter will have to be coordinated. + +=item C<$hold_type> + +The type of hold being placed: any copy, a specific copy, any +copy from a particular branch or location. See the SIP protocol +specification for the exact values that this parameter might +take. + +=item C<$fee_ack> + +Boolean. If true, the patron has acknowleged that she is willing +to pay the fee associated with placing a hold on this item. If +C<$fee_ack> is false, then the ILS should refuse to place the +hold. + +=back + +=head2 C<$status = $ils-Ecancel_hold($patron_id, $patron_pwd, $item_id, $title_id);> + +Cancel a hold placed by C<$patron_id> for the item identified by +C<$item_id> or C<$title_id>. The patron password C<$patron_pwd> +may be C, if it was not provided by the terminal. + +=head2 C<$status = $ils-Ealter_hold($patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack);> + +The C<$status> object returned by C<$ils-Eadd_hold>, +C<$ils-Ecancel_hold>, and C<$ils-Ealter_hold> must all +support the same methods: + +=over + +=item C + +Returns the expiry date for the placed hold, in seconds since the +epoch. + +=item C + +Returns the new hold's place in the queue of outstanding holds. + +=item C + +Returns the location code for the pickup location. + +=back + +=head2 C<$status = $ils-Erenew($patron_id, $patron_pwd, $item_id, $title_id, $no_block, $nb_due_date, $third_party, $item_props, $fee_ack);> + +Renew the item identified by C<$item_id> or C<$title_id>, as +requested by C<$patron_id> (with password C<$patron_pwd>). The +item has the properties C<$item_props> associated with it. + +If the patron renewed the item while the terminal was +disconnected from the net, then it is a C<$no_block> transaction, +and the due date assigned by the terminal, and reported to the +patron was C<$nb_due_date> (so we have to honor it). + +If there is a fee associated with renewing the item, and the +patron has agreed to pay the fee, then C<$fee_ack> will be +C<'Y'>. + +If C<$third_party> is C<'Y'> and the book is not checked out to +C<$patron_id>, but to some other person, then this is a +third-party renewal; the item should be renewed for the person to +whom it is checked out, rather than checking it out to +C<$patron_id>, or the renewal should fail. + +The C<$status> object returned by C<$ils-Erenew> must support +the following methods: + +=over + +=item C + +Boolean. If C is true, then the item was already +checked out to the patron, so it is being renewed. If +C is false, then the patron did not already have the +item checked out. + +NOTE: HOW IS THIS USED IN PRACTICE? + +=item C, C, C, C, C, C + +See C<$ils-Echeckout> for these methods. + +=back + +=head2 C<$status = $ils-Erenew_all($patron_id, $patron_pwd, $fee_ack);> + +Renew all items checked out by C<$patron_id> (with password +C<$patron_pwd>). If the patron has agreed to pay any fees +associated with this transaction, then C<$fee_ack> will be +C<'Y'>. + +The C<$status> object must support the following methods: + +=over + +=item C + +Returns a list of the C<$item_id>s of the items that were renewed. + +=item C + +Returns a list of the C<$item_id>s of the items that were not renewed. + +=back diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm new file mode 100644 index 0000000000..e35fd37f95 --- /dev/null +++ b/C4/SIP/ILS/Item.pm @@ -0,0 +1,214 @@ +# +# ILS::Item.pm +# +# A Class for hiding the ILS's concept of the item from the OpenSIP +# system +# + +package ILS::Item; + +use strict; +use warnings; + +use Sys::Syslog qw(syslog); + +use ILS::Transaction; + +our %item_db = ( + '1565921879' => { + title => "Perl 5 desktop reference", + id => '1565921879', + sip_media_type => '001', + magnetic_media => 0, + hold_queue => [], + }, + '0440242746' => { + title => "The deep blue alibi", + id => '0440242746', + sip_media_type => '001', + magnetic_media => 0, + hold_queue => [], + }, + '660' => { + title => "Harry Potter y el cáliz de fuego", + id => '660', + sip_media_type => '001', + magnetic_media => 0, + hold_queue => [], + }, + ); + +sub new { + my ($class, $item_id) = @_; + my $type = ref($class) || $class; + my $self; + + + if (!exists($item_db{$item_id})) { + syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id); + return undef; + } + + $self = $item_db{$item_id}; + bless $self, $type; + + syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'", + $item_id, $self->{title}); + + return $self; +} + +sub magnetic { + my $self = shift; + + return $self->{magnetic_media}; +} + +sub sip_media_type { + my $self = shift; + + return $self->{sip_media_type}; +} + +sub sip_item_properties { + my $self = shift; + + return $self->{sip_item_properties}; +} + +sub status_update { + my ($self, $props) = @_; + my $status = new ILS::Transaction; + + $self->{sip_item_properties} = $props; + $status->{ok} = 1; + + return $status; +} + + +sub id { + my $self = shift; + + return $self->{id}; +} + +sub title_id { + my $self = shift; + + return $self->{title}; +} + +sub permanent_location { + my $self = shift; + + return $self->{permanent_location} || ''; +} + +sub current_location { + my $self = shift; + + return $self->{current_location} || ''; +} + +sub sip_circulation_status { + my $self = shift; + + if ($self->{patron}) { + return '04'; + } elsif (scalar @{$self->{hold_queue}}) { + return '08'; + } else { + return '03'; + } +} + +sub sip_security_marker { + return '02'; +} + +sub sip_fee_type { + return '01'; +} + +sub fee { + my $self = shift; + + return $self->{fee} || 0; +} + +sub fee_currency { + my $self = shift; + + return $self->{currency} || 'CAD'; +} + +sub owner { + my $self = shift; + + return 'UWOLS'; +} + +sub hold_queue { + my $self = shift; + + return $self->{hold_queue}; +} + +sub hold_queue_position { + my ($self, $patron_id) = @_; + my $i; + + for ($i = 0; $i < scalar @{$self->{hold_queue}}; $i += 1) { + if ($self->{hold_queue}[$i]->{patron_id} eq $patron_id) { + return $i + 1; + } + } + return 0; +} + +sub due_date { + my $self = shift; + + return $self->{due_date} || 0; +} + +sub recall_date { + my $self = shift; + + return $self->{recall_date} || 0; +} + +sub hold_pickup_date { + my $self = shift; + + return $self->{hold_pickup_date} || 0; +} + +sub screen_msg { + my $self = shift; + + return $self->{screen_msg} || ''; +} + +sub print_line { + my $self = shift; + + return $self->{print_line} || ''; +} + +# An item is available for a patron if +# 1) It's not checked out and (there's no hold queue OR patron +# is at the front of the queue) +# OR +# 2) It's checked out to the patron and there's no hold queue +sub available { + my ($self, $for_patron) = @_; + + return ((!defined($self->{patron_id}) && (!scalar @{$self->{hold_queue}} + || ($self->{hold_queue}[0] eq $for_patron))) + || ($self->{patron_id} && ($self->{patron_id} eq $for_patron) + && !scalar @{$self->{hold_queue}})); +} + +1; diff --git a/C4/SIP/ILS/Item.pod b/C4/SIP/ILS/Item.pod new file mode 100644 index 0000000000..6420b57246 --- /dev/null +++ b/C4/SIP/ILS/Item.pod @@ -0,0 +1,231 @@ +=head1 NAME + +ILS::Item - Portable Item status object class for SIP + +=head1 SYNOPSIS + + use ILS; + use ILS::Item; + + # Look up item based on item_id + my $item = new ILS::Item $item_id; + + # Basic object access methods + $item_id = $item->id; + $title = $item->title_id; + $media_type = $item->sip_media_type; + $bool = $item->magnetic; + $locn = $item->permanent_location; + $locn = $item->current_location; + $props = $item->sip_item_props; + $owner = $item->owner; + $str = $item->sip_circulation_status; + $bool = $item->available; + @hold_queue = $item->hold_queue; + $pos = $item->hold_queue_position($patron_id); + $due = $item->due_date; + $pickup = $item->hold_pickup_date; + $recall = $item->recall_date; + $fee = $item->fee; + $currency = $item->fee_currency; + $type = $item->sip_fee_type; + $mark = $item->sip_security_marker; + $msg = $item->screen_msg; + $msg = $item->print_line; + + # Operations on items + $status = $item->status_update($item_props); + +=head1 DESCRIPTION + +An C object holds the information necessary to +circulate an item in the library's collection. It does not need +to be a complete bibliographic description of the item; merely +basic human-appropriate identifying information is necessary +(that is, not the barcode, but just a title, and maybe author). + +For the most part, Cs are not operated on directly, +but are passed to C methods as part of a transaction. That +is, rather than having an item check itself in: + + $item->checkin; + +the code tells the ILS that the item has returned: + + $ils->checkin($item_id); + +Similarly, patron's don't check things out (a la, +C<$patron-Echeckout($item)>), but the ILS checks items out to +patrons. This means that the methods that are defined for items +are, almost exclusively, methods to retrieve information about +the state of the item. + +=over + +=item C<$item_id = $item-Eid> + +Return the item ID, or barcode, of C<$item>. + +=item C<$title = $item-Etitle_id> + +Return the title, or some other human-relevant description, of +the item. + +=item C<$media_type = $item-Emedia_type> + +Return the SIP-defined media type of the item. The specification +provides the following definitions: + + 000 Other + 001 Book + 002 Magazine + 003 Bound journal + 004 Audio tape + 005 Video tape + 006 CD/CDROM + 007 Diskette + 008 Book with diskette + 009 Book with CD + 010 Book with audio tape + +The SIP server does not use the media type code to alter its +behavior at all; it merely passes it through to the self-service +terminal. In particular, it does not set indicators related to +whether an item is magnetic, or whether it should be +desensitized, based on this return type. The +C<$item-Emagnetic> method will be used for that purpose. + +=item C + +Is the item some form of magnetic media (eg, a video or a book +with an accompanying floppy)? This method will not be called +unless + + $ils->supports('magnetic media') + +returns C. + +If this method is defined, it is assumed to return either C +or C for every item. If the magnetic media indication is +not supported by the ILS, then the SIP server will indicate that +all items are 'Unknown'. + +=item C<$locn = $item-Epermanent_location> + +Where does this item normally reside? The protocol specification +is not clear on whether this is the item's "home branch", or a +location code within the branch, merely stating that it is, "The +location where an item is normally stored after being checked +in." + +=item C<$locn = $item-Ecurrent_location> + +According to the protocol, "[T]he current location of the item. +[A checkin terminal] could set this field to the ... system +terminal location on a Checkin message." + +=item C<$props = $item-Esip_item_props> + +Returns "item properties" associated with the item. This is an +(optional) opaque string that is passed between the self-service +terminals and the ILS. It can be set by the terminal, and should +be stored in the ILS if it is. + +=item C<$owner = $item-Eowner> + +The spec says, "This field might contain the name of the +institution or library that owns the item." + +=item C<$str = $item-Esip_circulation_status> + +Returns a two-character string describing the circulation status +of the item, as defined in the specification: + + 01 Other + 02 On order + 03 Available + 04 Charged + 05 Charged; not to be recalled until earliest recall date + 06 In process + 07 Recalled + 08 Waiting on hold shelf + 09 Waiting to be re-shelved + 10 In transit between library locations + 11 Claimed returned + 12 Lost + 13 Missing + +=item C<$bool = $item-Eavailable> + +Is the item available? That is, not checked out, and not on the +hold shelf? + +=item C<@hold_queue = $item-Ehold_queue> + +Returns a list of the C<$patron_id>s of the patrons that have +outstanding holds on the item. + +=item C<$pos = $item-Ehold_queue_position($patron_id)> + +Returns the location of C<$patron_id> in the hold queue for the +item, with '1' indicating the next person to receive the item. A +return status of '0' indicates that C<$patron_id> does not have a +hold on the item. + +=item C<$date = $item-Erecall_date> +=item C<$date = $item-Ehold_pickup_date> + +These functions all return the corresponding date as a standard +SIP-format timestamp: + + YYYYMMDDZZZZHHMMSS + +Where the C<'Z'> characters indicate spaces. + +=item C<$date = $item-Edue_date> + +Returns the date the item is due. The format for this timestamp +is not defined by the specification, but it should be something +simple for a human reader to understand. + +=item C<$fee = $item-Efee> + +The amount of the fee associated with borrowing this item. + +=item C<$currency = $item-Efee_currency> + +The currency in which the fee type above is denominated. This +field is the ISO standard 4217 three-character currency code. It +is highly unlikely that many systems will denominate fees in more +than one currency, however. + +=item C<$type = $item-Esip_fee_type> + +The type of fee being charged, as defined by the SIP protocol +specification: + + 01 Other/unknown + 02 Administrative + 03 Damage + 04 Overdue + 05 Processing + 06 Rental + 07 Replacement + 08 Computer access charge + 09 Hold fee + +=item C<$mark = $item-Esip_security_marker> + +The type of security system with which the item is tagged: + + 00 Other + 01 None + 02 3M Tattle-tape + 03 3M Whisper tape + +=item C<$msg = $item-Escreen_msg> +=item C<$msg = $item-Eprint_line> + +The usual suspects. + +=back diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm new file mode 100644 index 0000000000..ce7921050f --- /dev/null +++ b/C4/SIP/ILS/Patron.pm @@ -0,0 +1,393 @@ +# +# ILS::Patron.pm +# +# A Class for hiding the ILS's concept of the patron from the OpenSIP +# system +# + +package ILS::Patron; + +use strict; +use warnings; +use Exporter; + +use Sys::Syslog qw(syslog); +use Data::Dumper; + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(invalid_patron); + +our %patron_db = ( + djfiander => { + name => "David J. Fiander", + id => 'djfiander', + password => '6789', + ptype => 'A', # 'A'dult. Whatever. + birthdate => '19640925', + address => '2 Meadowvale Dr. St Thomas, ON', + home_phone => '(519) 555 1234', + email_addr => 'djfiander@hotmail.com', + charge_ok => 1, + renew_ok => 1, + recall_ok => 0, + hold_ok => 1, + card_lost => 0, + claims_returned => 0, + fines => 100, + fees => 0, + recall_overdue => 0, + items_billed => 0, + screen_msg => '', + print_line => '', + items => [], + hold_items => [], + overdue_items => [], + fine_items => ['Computer Time'], + recall_items => [], + unavail_holds => [], + inet => 1, + }, + miker => { + name => "Mike Rylander", + id => 'miker', + password => '6789', + ptype => 'A', # 'A'dult. Whatever. + birthdate => '19640925', + address => 'Somewhere in Atlanta', + home_phone => '(404) 555 1235', + email_addr => 'mrylander@gmail.com', + charge_ok => 1, + renew_ok => 1, + recall_ok => 0, + hold_ok => 1, + card_lost => 0, + claims_returned => 0, + fines => 0, + fees => 0, + recall_overdue => 0, + items_billed => 0, + screen_msg => '', + print_line => '', + items => [], + hold_items => [], + overdue_items => [], + fine_items => [], + recall_items => [], + unavail_holds => [], + inet => 0, + }, + ); + +sub new { + my ($class, $patron_id) = @_; + my $type = ref($class) || $class; + my $self; + + if (!exists($patron_db{$patron_id})) { + syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id); + return undef; + } + + $self = $patron_db{$patron_id}; + + syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id, + $self->{id}); + + bless $self, $type; + return $self; +} + +sub id { + my $self = shift; + + return $self->{id}; +} + +sub name { + my $self = shift; + + return $self->{name}; +} + +sub address { + my $self = shift; + + return $self->{address}; +} + +sub email_addr { + my $self = shift; + + return $self->{email_addr}; +} + +sub home_phone { + my $self = shift; + + return $self->{home_phone}; +} + +sub sip_birthdate { + my $self = shift; + + return $self->{birthdate}; +} + +sub ptype { + my $self = shift; + + return $self->{ptype}; +} + +sub language { + my $self = shift; + + return $self->{language} || '000'; # Unspecified +} + +sub charge_ok { + my $self = shift; + + return $self->{charge_ok}; +} + +sub renew_ok { + my $self = shift; + + return $self->{renew_ok}; +} + +sub recall_ok { + my $self = shift; + + return $self->{recall_ok}; +} + +sub hold_ok { + my $self = shift; + + return $self->{hold_ok}; +} + +sub card_lost { + my $self = shift; + + return $self->{card_lost}; +} + +sub recall_overdue { + my $self = shift; + + return $self->{recall_overdue}; +} + +sub check_password { + my ($self, $pwd) = @_; + + # If the patron doesn't have a password, + # then we don't need to check + return (!$self->{password} || ($pwd && ($self->{password} eq $pwd))); +} + +sub currency { + my $self = shift; + + return $self->{currency}; +} + +sub fee_amount { + my $self = shift; + + return $self->{fee_amount} || undef; +} + +sub screen_msg { + my $self = shift; + + return $self->{screen_msg}; +} + +sub print_line { + my $self = shift; + + return $self->{print_line}; +} + +sub too_many_charged { + my $self = shift; + + return $self->{too_many_charged}; +} + +sub too_many_overdue { + my $self = shift; + + return $self->{too_many_overdue}; +} + +sub too_many_renewal { + my $self = shift; + + return $self->{too_many_renewal}; +} + +sub too_many_claim_return { + my $self = shift; + + return $self->{too_many_claim_return}; +} + +sub too_many_lost { + my $self = shift; + + return $self->{too_many_lost}; +} + +sub excessive_fines { + my $self = shift; + + return $self->{excessive_fines}; +} + +sub excessive_fees { + my $self = shift; + + return $self->{excessive_fees}; +} + +sub too_many_billed { + my $self = shift; + + return $self->{too_many_billed}; +} + +# +# List of outstanding holds placed +# +sub hold_items { + my ($self, $start, $end) = @_; + + $start = 1 if !defined($start); + $end = scalar @{$self->{hold_items}} if !defined($end); + + return [@{$self->{hold_items}}[$start-1 .. $end-1]]; +} + +# +# remove the hold on item item_id from my hold queue. +# return true if I was holding the item, false otherwise. +# +sub drop_hold { + my ($self, $item_id) = @_; + my $i; + + for ($i = 0; $i < scalar @{$self->{hold_items}}; $i += 1) { + if ($self->{hold_items}[$i]->{item_id} eq $item_id) { + splice @{$self->{hold_items}}, $i, 1; + return 1; + } + } + + return 0; +} + +sub overdue_items { + my ($self, $start, $end) = @_; + + $start = 1 if !defined($start); + $end = scalar @{$self->{overdue_items}} if !defined($end); + + return [@{$self->{overdue_items}}[$start-1 .. $end-1]]; +} + +sub charged_items { + my ($self, $start, $end) = shift; + + $start = 1 if !defined($start); + $end = scalar @{$self->{items}} if !defined($end); + + syslog("LOG_DEBUG", "charged_items: start = %d, end = %d", $start, $end); + syslog("LOG_DEBUG", "charged_items: items = (%s)", + join(', ', @{$self->{items}})); + + return [@{$self->{items}}[$start-1 .. $end-1]]; +} + +sub fine_items { + my ($self, $start, $end) = @_; + + $start = 1 if !defined($start); + $end = scalar @{$self->{fine_items}} if !defined($end); + + return [@{$self->{fine_items}}[$start-1 .. $end-1]]; +} + +sub recall_items { + my ($self, $start, $end) = @_; + + $start = 1 if !defined($start); + $end = scalar @{$self->{recall_items}} if !defined($end); + + return [@{$self->{recall_items}}[$start-1 .. $end-1]]; +} + +sub unavail_holds { + my ($self, $start, $end) = @_; + + $start = 1 if !defined($start); + $end = scalar @{$self->{unavail_holds}} if !defined($end); + + return [@{$self->{unavail_holds}}[$start-1 .. $end-1]]; +} + +sub block { + my ($self, $card_retained, $blocked_card_msg) = @_; + + foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') { + $self->{$field} = 0; + } + + $self->{screen_msg} = $blocked_card_msg || "Card Blocked. Please contact library staff"; + + return $self; +} + +sub enable { + my $self = shift; + + foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') { + $self->{$field} = 1; + } + + syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s", + $self->{id}, $self->{charge_ok}, $self->{renew_ok}, + $self->{recall_ok}, $self->{hold_ok}); + + $self->{screen_msg} = "All privileges restored."; + + return $self; +} + + +sub inet_privileges { + my $self = shift; + + return $self->{inet} ? 'Y' : 'N'; +} + +# +# Messages +# + +sub invalid_patron { + return "Please contact library staff"; +} + +sub charge_denied { + return "Please contact library staff"; +} + +1; diff --git a/C4/SIP/ILS/Patron.pod b/C4/SIP/ILS/Patron.pod new file mode 100644 index 0000000000..9bc750a5d1 --- /dev/null +++ b/C4/SIP/ILS/Patron.pod @@ -0,0 +1,210 @@ +=head1 NAME + +ILS::Patron - Portable Patron status object class for SIP + +=head1 DESCRIPTION + +A C object holds information about a patron that's +used by self service terminals to authenticate and authorize a patron, +and to display information about the patron's borrowing activity. + +=head1 SYNOPSIS + + use ILS; + use ILS::Patron; + + # Look up patron based on patron_id + my $patron = new ILS::Patron $patron_id + + # Basic object access methods + $patron_id = $patron->id; + $str = $patron->name; + $str = $patron->address; + $str = $patron->email_addr; + $str = $patron->home_phone; + $str = $patron->sip_birthdate; + $str = $patron->ptype; + $str = $patron->language; + $str = $patron->password; + $str = $patron->check_password($password); + $str = $patron->currency; + $str = $patron->screen_msg; + $str = $patron->print_line; + + # Check patron permissions + $bool = $patron->charge_ok; + $bool = $patron->renew_ok; + $bool = $patron->recall_ok; + $bool = $patron->hold_ok; + $bool = $patron->card_lost; + $bool = $patron->too_many_charged; + $bool = $patron->too_many_overdue; + $bool = $patron->too_many_renewal; + $bool = $patron->too_many_claim_return; + $bool = $patron->too_many_lost; + $bool = $patron->excessive_fines; + $bool = $patron->excessive_fees; + $bool = $patron->too_many_billed; + + # Patron borrowing activity + $num = $patron->recall_overdue; + $num = $patron->fee_amount; + $bool = $patron->drop_hold($item_id); + @holds = $patron->hold_items($start, $end); + @items = $patron->overdue_items($start, $end); + @items = $patron->charged_items($start, $end); + @items = $patron->fine_items($start, $end); + @items = $patron->recall_items($start, $end); + @items = $patron->unavail_holds($start, $end); + + # Changing a patron's status + $patron->block($card_retained, $blocked_msg); + $patron->enable; + +=head1 INITIALIZATION + +A patron object is created by calling + + $patron = new ILS::Patron $patron_id; + +where C<$patron_id> is the patron's barcode as received from the +self service terminal. If the patron barcode is not registered, +then C should return C. + +=head1 BASIC OBJECT ACCESS METHODS + +The following functions return the corresponding information +about the given patron, or C if the information is +unavailable. + + $patron_id = $patron-Eid; + $str = $patron-Ename; + $str = $patron-Eaddress; + $str = $patron-Eemail_addr; + $str = $patron-Ehome_phone; + + $str = $patron-Escreen_msg; + $str = $patron-Eprint_line; + +If there are outstanding display messages associated with the +patron, then these return the screen message and print line, +respectively, as with the C methods. + +There are a few other object access methods that need a bit more +explication however. + +=head2 C<$str = $patron-Esip_birthdate;> + +Returns the patron's birthday formated according to the SIP +specification: + + YYYYMMDD HHMMSS + +=head2 C<$str = $patron-Eptype;> + +Returns the "patron type" of the patron. This is not used by the +SIP server code, but is passed through to the self service +terminal (using the non-standard protocol field "PC"). Some self +service terminals use the patron type in determining what level +of service to provide (for example, Envisionware computer +management software can be configured to filter internet access +based on patron type). + +=head2 C<$str = $patron-Elanguage;> + +A three-digit string encoding the patron's prefered language. +The full list is defined in the SIP specification, but some of +the important values are: + + 000 Unknown (default) + 001 English + 002 French + 008 Spanish + 011 Canadian French + 016 Arabic + 019 Chinese + 021 North American Spanish + +=head2 C<$bool = $patron-Echeck_password($password);> + +Returns C if C<$patron>'s password is C<$password>. + +=head2 C<$str = $patron-Ecurrency;> + +Returns the three character ISO 4217 currency code for the +patron's preferred currency. + +=head1 CHECKING PATRON PERMISSIONS + +Most of the methods associated with Patrons are related to +checking if they're authorized to perform various actions: + + $bool = $patron-Echarge_ok; + $bool = $patron-Erenew_ok; + $bool = $patron-Erecall_ok; + $bool = $patron-Ehold_ok; + $bool = $patron-Ecard_lost; + $bool = $patron-Erecall_overdue; + $bool = $patron-Etoo_many_charged; + $bool = $patron-Etoo_many_overdue; + $bool = $patron-Etoo_many_renewal; + $bool = $patron-Etoo_many_claim_return; + $bool = $patron-Etoo_many_lost; + $bool = $patron-Eexcessive_fines; + $bool = $patron-Eexcessive_fees; + $bool = $patron-Etoo_many_billed; + +=head1 LISTS OF ITEMS ASSOCIATED WITH THE USER + +The C<$patron> object provides a set of methods to find out +information about various sets that are associated with the +user. All these methods take two optional parameters: C<$start> +and C<$end>, which define a subset of the list of items to be +returned (C<1> is the first item in the list). The following +methods all return a reference to a list of C<$item_id>s: + + $items = $patron-Ehold_items($start, $end); + $items = $patron-Eoverdue_items($start, $end); + $items = $patron-Echarged_items($start, $end); + $items = $patron-Erecall_items($start, $end); + $items = $patron-Eunavail_holds($start, $end); + +It is also possible to retrieve an itemized list of the fines +outstanding. This method returns a reference to an itemized list +of fines: + + $fines = $patron-Efine_items($start, $end); + +=head1 PATRON BORROWING ACTIVITY + +=head2 C<$num = $patron-Efee_amount;> + +The total amount of fees and fines owed by the patron. + +=head2 C<$bool = $patron-Edrop_hold($item_id);> + +Drops the hold that C<$patron> has placed on the item +C<$item_id>. Returns C if the patron did not have a hold +on the item, C otherwise. + + + +=head1 CHANGING A PATRON'S STATUS + +=head2 C<$status = $ils-Eblock($card_retained, $blocked_card_msg);> + +Block the account of the patron identified by C<$patron_id>. If +the self check unit captured the patron's card, then +C<$card_retained> will be C. A message indicating why the +card was retained will be provided by the parameter +C<$blocked_card_msg>. + +This function returns an C object that has been +updated to indicate that the patron's privileges have been +blocked, or C if the patron ID is not valid. + +=head2 C<$patron-Eenable;> + +Reenable the patron after she's been blocked. This is a test +function and will not normally be called by self-service +terminals in production. diff --git a/C4/SIP/ILS/Transaction.pm b/C4/SIP/ILS/Transaction.pm new file mode 100644 index 0000000000..b6d2ac17f9 --- /dev/null +++ b/C4/SIP/ILS/Transaction.pm @@ -0,0 +1,59 @@ +# +# Transaction: Superclass of all the transactional status objects +# + +package ILS::Transaction; + +use Carp; +use strict; +use warnings; + +my %fields = ( + ok => 0, + patron => undef, + item => undef, + desensitize => 0, + alert => '', + transation_id => undef, + sip_fee_type => '01', # Other/Unknown + fee_amount => undef, + sip_currency => 'CAD', + screen_msg => '', + print_line => '', + ); + +our $AUTOLOAD; + +sub new { + my $class = shift; + my $self = { + _permitted => \%fields, + %fields, + }; + + return bless $self, $class; +} + +sub DESTROY { + # be cool +} + +sub AUTOLOAD { + my $self = shift; + my $class = ref($self) or croak "$self is not an object"; + my $name = $AUTOLOAD; + + $name =~ s/.*://; + + unless (exists $self->{_permitted}->{$name}) { + croak "Can't access '$name' field of class '$class'"; + } + + if (@_) { + return $self->{$name} = shift; + } else { + return $self->{$name}; + } +} + +1; diff --git a/C4/SIP/ILS/Transaction/Checkin.pm b/C4/SIP/ILS/Transaction/Checkin.pm new file mode 100644 index 0000000000..3f231d81c0 --- /dev/null +++ b/C4/SIP/ILS/Transaction/Checkin.pm @@ -0,0 +1,42 @@ +# +# An object to handle checkin status +# + +package ILS::Transaction::Checkin; + +use warnings; +use strict; + +use POSIX qw(strftime); + +use ILS; +use ILS::Transaction; + +our @ISA = qw(ILS::Transaction); + +my %fields = ( + magnetic => 0, + sort_bin => undef, + ); + +sub new { + my $class = shift;; + my $self = $class->SUPER::new(); + my $element; + + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + + @{$self}{keys %fields} = values %fields; + + return bless $self, $class; +} + +sub resensitize { + my $self = shift; + + return !$self->{item}->magnetic; +} + +1; diff --git a/C4/SIP/ILS/Transaction/Checkout.pm b/C4/SIP/ILS/Transaction/Checkout.pm new file mode 100644 index 0000000000..d445df7477 --- /dev/null +++ b/C4/SIP/ILS/Transaction/Checkout.pm @@ -0,0 +1,39 @@ +# +# An object to handle checkout status +# + +package ILS::Transaction::Checkout; + +use warnings; +use strict; + +use POSIX qw(strftime); + +use ILS; +use ILS::Transaction; + +our @ISA = qw(ILS::Transaction); + +# Most fields are handled by the Transaction superclass +my %fields = ( + security_inhibit => 0, + due => undef, + renew_ok => 0, + ); + +sub new { + my $class = shift;; + my $self = $class->SUPER::new(); + my $element; + + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + + @{$self}{keys %fields} = values %fields; + $self->{'due'} = time() + (60*60*24*14); # two weeks hence + + return bless $self, $class; +} + +1; diff --git a/C4/SIP/ILS/Transaction/FeePayment.pm b/C4/SIP/ILS/Transaction/FeePayment.pm new file mode 100644 index 0000000000..09fd508c59 --- /dev/null +++ b/C4/SIP/ILS/Transaction/FeePayment.pm @@ -0,0 +1,12 @@ +package ILS::Transaction::FeePaid; + +use Exporter; +use warnings; +use strict; + +use ILS; +use ILS::Transaction; + +our @ISA = qw(Exporter ILS::Transaction); + +1; diff --git a/C4/SIP/ILS/Transaction/Hold.pm b/C4/SIP/ILS/Transaction/Hold.pm new file mode 100644 index 0000000000..14b3a9d89b --- /dev/null +++ b/C4/SIP/ILS/Transaction/Hold.pm @@ -0,0 +1,39 @@ +# +# status of a Hold transaction + +package ILS::Transaction::Hold; + +use warnings; +use strict; + +use ILS; +use ILS::Transaction; + +our @ISA = qw(ILS::Transaction); + +my %fields = ( + expiration_date => 0, + pickup_location => undef, + ); + +sub new { + my $class = shift;; + my $self = $class->SUPER::new(); + my $element; + + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + + @{$self}{keys %fields} = values %fields; + + return bless $self, $class; +} + +sub queue_position { + my $self = shift; + + return $self->item->hold_queue_position($self->patron->id); +} + +1; diff --git a/C4/SIP/ILS/Transaction/Renew.pm b/C4/SIP/ILS/Transaction/Renew.pm new file mode 100644 index 0000000000..40c9ae4ffa --- /dev/null +++ b/C4/SIP/ILS/Transaction/Renew.pm @@ -0,0 +1,33 @@ +# +# Status of a Renew Transaction +# + +package ILS::Transaction::Renew; + +use warnings; +use strict; + +use ILS; +use ILS::Transaction; + +our @ISA = qw(ILS::Transaction); + +my %fields = ( + renewal_ok => 0, + ); + +sub new { + my $class = shift;; + my $self = $class->SUPER::new(); + my $element; + + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + + @{$self}{keys %fields} = values %fields; + + return bless $self, $class; +} + +1; diff --git a/C4/SIP/ILS/Transaction/RenewAll.pm b/C4/SIP/ILS/Transaction/RenewAll.pm new file mode 100644 index 0000000000..6f3b90d0e4 --- /dev/null +++ b/C4/SIP/ILS/Transaction/RenewAll.pm @@ -0,0 +1,29 @@ +# +# RenewAll: class to manage status of "Renew All" transaction + +package ILS::Transaction::RenewAll; + +use strict; +use warnings; + +our @ISA = qw(ILS::Transaction); + +my %fields = ( + renewed => [], + unrenewed => [], + ); +sub new { + my $class = shift;; + my $self = $class->SUPER::new(); + my $element; + + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + + @{$self}{keys %fields} = values %fields; + + return bless $self, $class; +} + +1; diff --git a/C4/SIP/Makefile b/C4/SIP/Makefile new file mode 100644 index 0000000000..2f670bbbb2 --- /dev/null +++ b/C4/SIP/Makefile @@ -0,0 +1,26 @@ +# +# There's not a lot to "make", but this simplifies the usual +# sorts of tasks +# + +PODFLAGS = --htmlroot=. --podroot=. + +.SUFFIXES: .pod .html + +.pod.html: + pod2html $(PODFLAGS) --outfile=$@ --infile=$< + +all: + @echo Nothing to make. The command '"make run"' will run the server. + +# just run the server from the command line +run: + perl SIPServer.pm SIPconfig.xml + +test: + cd t; $(MAKE) test + +tags: + find . -name '*.pm' -print | etags - + +html: ILS.html ILS/Item.html ILS/Patron.html diff --git a/C4/SIP/README b/C4/SIP/README new file mode 100755 index 0000000000..73acdfdd9b --- /dev/null +++ b/C4/SIP/README @@ -0,0 +1,24 @@ +README for Open NSIP 3M-SIP Server + +DEPENDENCIES + +SIPServer is written entirely in Perl, but it require these CPAN +perl modules to run: + + Net::Server - The SIP server is a Net::Server::Prefork server + XML::LibXML + XML::Parser + XML::Simple - for parsing the config file + UNIVERSAL::require - for loading the correct ILS interface module + Clone - for running the test cases + +LOGGING + +SIPServer uses syslog() for status and debugging messages. All +syslog messages are logged using the syslog facility 'local6'. +If you need to change this, because something else on your system +is already using that facililty, just change the definition of +'LOG_SIP' at the top of the file SIPServer.pm + +Make sure to update your syslog configuration to capture facility +'local6' and record it. diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm new file mode 100644 index 0000000000..85d5b46e2c --- /dev/null +++ b/C4/SIP/SIPServer.pm @@ -0,0 +1,273 @@ +package SIPServer; + +use strict; +use warnings; +use Exporter; +use Sys::Syslog qw(syslog); +use Net::Server::PreFork; +use IO::Socket::INET; +use Socket; +use Data::Dumper; # For debugging +require UNIVERSAL::require; + +#use Sip qw(readline); +use Sip::Constants qw(:all); +use Sip::Configuration; +use Sip::Checksum qw(checksum verify_cksum); +use Sip::MsgType; + +use constant LOG_SIP => "local6"; # Local alias for the logging facility + +our @ISA = qw(Net::Server::PreFork); +# +# Main +# + +my %transports = ( + RAW => \&raw_transport, + telnet => \&telnet_transport, + http => \&http_transport, +); + +# Read configuration + +my $config = new Sip::Configuration $ARGV[0]; + +my @parms; + +# +# Ports to bind +# +foreach my $svc (keys %{$config->{listeners}}) { + push @parms, "port=" . $svc; +} + +# +# Logging +# +push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server", + "syslog_facility=" . LOG_SIP; + +# +# Server Management: set parameters for the Net::Server::PreFork +# module. The module silently ignores parameters that it doesn't +# recognize, and complains about invalid values for parameters +# that it does. +# +if (defined($config->{'server-params'})) { + while (my ($key, $val) = each %{$config->{'server-params'}}) { + push @parms, $key . '=' . $val; + } +} + +print Dumper(@parms); + +# +# This is the main event. +SIPServer->run(@parms); + +# +# Child +# + +# process_request is the callback used by Net::Server to handle +# an incoming connection request. + +sub process_request { + my $self = shift; + my $service; + my $sockname; + my ($sockaddr, $port, $proto); + my $transport; + + $self->{config} = $config; + + $sockname = getsockname(STDIN); + ($port, $sockaddr) = sockaddr_in($sockname); + $sockaddr = inet_ntoa($sockaddr); + $proto = $self->{server}->{client}->NS_proto(); + + $self->{service} = $config->find_service($sockaddr, $port, $proto); + + if (!defined($self->{service})) { + syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); + die "process_request: Bad server connection"; + } + + $transport = $transports{$self->{service}->{transport}}; + + if (!defined($transport)) { + syslog("LOG_WARN", "Unknown transport '%s', dropping", $service->{transport}); + return; + } else { + &$transport($self); + } +} + +# +# Transports +# + +sub raw_transport { + my $self = shift; + my ($uid, $pwd); + my $input; + my $service = $self->{service}; + my $strikes = 3; + my $expect; + my $inst; + + eval { + local $SIG{ALRM} = sub { die "alarm\n"; }; + syslog("LOG_DEBUG", "raw_transport: timeout is %d", + $service->{timeout}); + while ($strikes--) { + alarm $service->{timeout}; + $input = Sip::read_SIP_packet(*STDIN); + alarm 0; + + if (!$input) { + # EOF on the socket + syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); + return; + } + + $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator + + last if Sip::MsgType::handle($input, $self, LOGIN); + } + }; + + if ($@) { + syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'"); + die "raw_transport: login error, exiting"; + } elsif (!$self->{account}) { + syslog("LOG_ERR", "raw_transport: LOGIN FAILED"); + die "raw_transport: Login failed, exiting"; + } + + syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", + $self->{account}->{id}, + $self->{account}->{institution}); + + $self->sip_protocol_loop(); + + syslog("LOG_INFO", "raw_transport: shutting down"); +} + +sub telnet_transport { + my $self = shift; + my ($uid, $pwd); + my $strikes = 3; + my $account = undef; + my $input; + my $config = $self->{config}; + + # Until the terminal has logged in, we don't trust it + # so use a timeout to protect ourselves from hanging. + eval { + local $SIG{ALRM} = sub { die "alarm\n"; }; + local $|; + my $timeout = 0; + + $| = 1; # Unbuffered output + $timeout = $config->{timeout} if (exists($config->{timeout})); + + while ($strikes--) { + print "login: "; + alarm $timeout; + $uid = ; + alarm 0; + + print "password: "; + alarm $timeout; + $pwd = ; + alarm 0; + + $uid =~ s/[\r\n]+$//; + $pwd =~ s/[\r\n]+$//; + + if (exists($config->{accounts}->{$uid}) + && ($pwd eq $config->{accounts}->{$uid}->password())) { + $account = $config->{accounts}->{$uid}; + last; + } else { + syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid); + print("Invalid login\n"); + } + } + }; # End of eval + + if ($@) { + syslog("LOG_ERR", "telnet_transport: Login timed out"); + die "Telnet Login Timed out"; + } elsif (!defined($account)) { + syslog("LOG_ERR", "telnet_transport: Login Failed"); + die "Login Failure"; + } else { + print "Login OK. Initiating SIP\n"; + } + + $self->{account} = $account; + + $self->sip_protocol_loop(); + syslog("LOG_INFO", "telnet_transport: shutting down"); +} + + +sub http_transport { +} + +# +# The terminal has logged in, using either the SIP login process +# over a raw socket, or via the pseudo-unix login provided by the +# telnet transport. From that point on, both the raw and the telnet +# processes are the same: +sub sip_protocol_loop { + my $self = shift; + my $expect; + my $service = $self->{service}; + my $config = $self->{config}; + my $input; + + # Now that the terminal has logged in, the first message + # we recieve must be an SC_STATUS message. But it might be + # an SC_REQUEST_RESEND. So, as long as we keep receiving + # SC_REQUEST_RESEND, we keep waiting for an SC_STATUS + + # Comprise reports that no other ILS actually enforces this + # constraint, so we'll relax about it too. As long as everybody + # uses the SIP "raw" login process, rather than telnet, this + # will be fine, becaues the LOGIN protocol exchange will force + # us into SIP 2.00 anyway. Machines that want to log in using + # telnet MUST send an SC Status message first, even though we're + # not enforcing it. + # + #$expect = SC_STATUS; + $expect = ''; + + while ($input = Sip::read_SIP_packet(*STDIN)) { + my $status; + + $input =~ s/[\r\n]+$//sm; # Strip off any trailing line ends + + $status = Sip::MsgType::handle($input, $self, $expect); + next if $status eq REQUEST_ACS_RESEND; + + if (!$status) { + syslog("LOG_ERR", "raw_transport: failed to handle %s", + substr($input, 0, 2)); + die "raw_transport: dying"; + } elsif ($expect && ($status ne $expect)) { + # We received a non-"RESEND" that wasn't what we were + # expecting. + syslog("LOG_ERR", + "raw_transport: expected %s, received %s, exiting", + $expect, $input); + die "raw_transport: exiting: expected '$expect', received '$status'"; + } + # We successfully received and processed what we were expecting + # to receive + $expect = ''; + } +} diff --git a/C4/SIP/SIPconfig.xml b/C4/SIP/SIPconfig.xml new file mode 100644 index 0000000000..079c88d6a4 --- /dev/null +++ b/C4/SIP/SIPconfig.xml @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm new file mode 100644 index 0000000000..3b826ef91e --- /dev/null +++ b/C4/SIP/Sip.pm @@ -0,0 +1,188 @@ +# +# Sip.pm: General Sip utility functions +# + +package Sip; + +use strict; +use warnings; +use English; +use Exporter; + +use Sys::Syslog qw(syslog); +use POSIX qw(strftime); + +use Sip::Constants qw(SIP_DATETIME); +use Sip::Checksum qw(checksum); + +our @ISA = qw(Exporter); + +our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count + denied sipbool boolspace write_msg read_SIP_packet + $error_detection $protocol_version $field_delimiter + $last_response); + +our %EXPORT_TAGS = ( + all => [qw(y_or_n timestamp add_field maybe_add + add_count denied sipbool boolspace write_msg + read_SIP_packet + $error_detection $protocol_version + $field_delimiter $last_response)]); + + +our $error_detection = 0; +our $protocol_version = 1; +our $field_delimiter = '|'; # Protocol Default + +# We need to keep a copy of the last message we sent to the SC, +# in case there's a transmission error and the SC sends us a +# REQUEST_ACS_RESEND. If we receive a REQUEST_ACS_RESEND before +# we've ever sent anything, then we are to respond with a +# REQUEST_SC_RESEND (p.16) + +our $last_response = ''; + +sub timestamp { + my $time = $_[0] || time(); + + return strftime(SIP_DATETIME, localtime($time)); +} + +# +# add_field(field_id, value) +# return constructed field value +# +sub add_field { + my ($field_id, $value) = @_; + my ($i, $ent); + + if (!defined($value)) { + syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'", + $field_id); + $value = ''; + } + + # Replace any occurences of the field delimiter in the + # field value with the HTML character entity + $ent = sprintf("&#%d;", ord($field_delimiter)); + + while (($i = index($value, $field_delimiter)) != ($[-1)) { + substr($value, $i, 1) = $ent; + } + + return $field_id . $value . $field_delimiter; +} +# +# maybe_add(field_id, value): +# If value is defined and non-empty, then return the +# constructed field value, otherwise return the empty string +# +sub maybe_add { + my ($fid, $value) = @_; + + return (defined($value) && $value) ? add_field($fid, $value) : ''; +} + +# +# add_count() produce fixed four-character count field, +# or a string of four spaces if the count is invalid for some +# reason +# +sub add_count { + my ($label, $count) = @_; + + # If the field is unsupported, it will be undef, return blanks + # as per the spec. + if (!defined($count)) { + return ' ' x 4; + } + + $count = sprintf("%04d", $count); + if (length($count) != 4) { + syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'", + $label, $count); + $count = ' ' x 4; + } + return $count; +} + +# +# denied($bool) +# if $bool is false, return true. This is because SIP statuses +# are inverted: we report that something has been denied, not that +# it's permitted. For example, 'renewal priv. denied' of 'Y' means +# that the user's not permitted to renew. I assume that the ILS has +# real positive tests. +# +sub denied { + my $bool = shift; + + return boolspace(!$bool); +} + +sub sipbool { + my $bool = shift; + + return $bool ? 'Y' : 'N'; +} + +# +# boolspace: ' ' is false, 'Y' is true. (don't ask) +# +sub boolspace { + my $bool = shift; + + return $bool ? 'Y' : ' '; +} + + +# read_SIP_packet($file) +# +# Read a packet from $file, using the correct record separator +# +sub read_SIP_packet { + my $file = shift; + my $record; + local $/ = "\r"; + + $record = readline($file); + syslog("LOG_INFO", "INPUT MSG: '$record'") if $record; + return $record; +} + +# +# write_msg($msg, $file) +# +# Send $msg to the SC. If error detection is active, then +# add the sequence number (if $seqno is non-zero) and checksum +# to the message, and save the whole thing as $last_response +# +# If $file is set, then it's a file handle: write to it, otherwise +# just write to the default destination. +# + +sub write_msg { + my ($self, $msg, $file) = @_; + my $cksum; + + if ($error_detection) { + if (defined($self->{seqno})) { + $msg .= 'AY' . $self->{seqno}; + } + $msg .= 'AZ'; + $cksum = checksum($msg); + $msg .= sprintf('%04.4X', $cksum); + } + + + if ($file) { + print $file "$msg\r"; + } else { + print "$msg\r"; + syslog("LOG_INFO", "OUTPUT MSG: '$msg'"); + } + + $last_response = $msg; +} + +1; diff --git a/C4/SIP/Sip/Checksum.pm b/C4/SIP/Sip/Checksum.pm new file mode 100644 index 0000000000..8d046c6a00 --- /dev/null +++ b/C4/SIP/Sip/Checksum.pm @@ -0,0 +1,55 @@ +package Sip::Checksum; + +use Exporter; +use strict; +use warnings; + +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(checksum verify_cksum); + +sub checksum { + my $pkt = shift; + + return (-unpack('%16U*', $pkt) & 0xFFFF); +} + +sub verify_cksum { + my $pkt = shift; + my $cksum; + my $shortsum; + + return 0 if (substr($pkt, -6, 2) ne "AZ"); # No checksum at end + + # Convert the checksum back to hex and calculate the sum of the + # pack without the checksum. + $cksum = hex(substr($pkt, -4)); + $shortsum = unpack("%16U*", substr($pkt, 0, -4)); + + # The checksum is valid if the hex sum, plus the checksum of the + # base packet short when truncated to 16 bits. + return (($cksum + $shortsum) & 0xFFFF) == 0; +} + +{ + no warnings qw(once); + eval join('',) || die $@ unless caller(); +} +__END__ + +# +# Some simple test data +# +sub test { + my $testpkt = shift; + my $cksum = checksum($testpkt); + my $fullpkt = sprintf("%s%4X", $testpkt, $cksum); + + print $fullpkt, "\n"; +} + +while (<>) { + chomp; + test($_); +} + +1; diff --git a/C4/SIP/Sip/Configuration.pm b/C4/SIP/Sip/Configuration.pm new file mode 100644 index 0000000000..1d0aa4bc50 --- /dev/null +++ b/C4/SIP/Sip/Configuration.pm @@ -0,0 +1,105 @@ +# +# parse-config: Parse an XML-format +# ACS configuration file and build the configuration +# structure. +# + +package Sip::Configuration; + +use strict; +use English; +use warnings; +use XML::Simple qw(:strict); + +use Sip::Configuration::Institution; +use Sip::Configuration::Account; +use Sip::Configuration::Service; + +my $parser = new XML::Simple( KeyAttr => { login => '+id', + institution => '+id', + service => '+port' }, + GroupTags => { listeners => 'service', + accounts => 'login', + institutions => 'institution', }, + ForceArray=> [ 'service', + 'login', + 'institution' ], + ValueAttr => { 'error-detect' => 'enabled', + 'min_servers' => 'value', + 'max_servers' => 'value'} ); + +sub new { + my ($class, $config_file) = @_; + my $cfg = $parser->XMLin($config_file); + my %listeners; + + foreach my $acct (values %{$cfg->{accounts}}) { + new Sip::Configuration::Account $acct; + } + + # The key to the listeners hash is the 'port' component of the + # configuration, which is of the form '[host]:[port]/proto', and + # the 'proto' component could be upper-, lower-, or mixed-cased. + # Regularize it here to lower-case, and then do the same below in + # find_server() when building the keys to search the hash. + + foreach my $service (values %{$cfg->{listeners}}) { + new Sip::Configuration::Service $service; + $listeners{lc $service->{port}} = $service; + } + $cfg->{listeners} = \%listeners; + + foreach my $inst (values %{$cfg->{institutions}}) { + new Sip::Configuration::Institution $inst; + } + + return bless $cfg, $class; +} + +sub error_detect { + my $self = shift; + + return $self->{'error-detect'}; +} + +sub accounts { + my $self = shift; + + return values %{$self->{accounts}}; +} + +sub find_service { + my ($self, $sockaddr, $port, $proto) = @_; + my $portstr; + + foreach my $addr ('', '*:', "$sockaddr:") { + $portstr = sprintf("%s%s/%s", $addr, $port, lc $proto); + Sys::Syslog::syslog("LOG_DEBUG", "Configuration::find_service: Trying $portstr"); + last if (exists(($self->{listeners})->{$portstr})); + } + + return $self->{listeners}->{$portstr}; +} + +# +# Testing +# + + +{ + no warnings qw(once); + eval join('',) || die $@ unless caller(); +} + +1; +__END__ + + my $config = new Sip::Configuration $ARGV[0]; + + +foreach my $acct ($config->accounts) { + print "Found account '", $acct->name, "', part of '" + print $acct->institution, "'\n"; +} + +1; diff --git a/C4/SIP/Sip/Configuration/Account.pm b/C4/SIP/Sip/Configuration/Account.pm new file mode 100644 index 0000000000..8b2a0e74cb --- /dev/null +++ b/C4/SIP/Sip/Configuration/Account.pm @@ -0,0 +1,43 @@ +# +# +# +# + +package Sip::Configuration::Account; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +sub id { + my $self = shift; + + return $self->{id}; +} + +sub institution { + my $self = shift; + + return $self->{institution}; +} + +sub password { + my $self = shift; + + return $self->{password}; +} + +1; diff --git a/C4/SIP/Sip/Configuration/Institution.pm b/C4/SIP/Sip/Configuration/Institution.pm new file mode 100644 index 0000000000..f31ecc8924 --- /dev/null +++ b/C4/SIP/Sip/Configuration/Institution.pm @@ -0,0 +1,31 @@ +# +# +# +# + +package Sip::Configuration::Institution; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +sub name { + my $self = shift; + + return $self->{name}; +} + +1; diff --git a/C4/SIP/Sip/Configuration/Service.pm b/C4/SIP/Sip/Configuration/Service.pm new file mode 100644 index 0000000000..11fa8aba67 --- /dev/null +++ b/C4/SIP/Sip/Configuration/Service.pm @@ -0,0 +1,25 @@ +# +# +# +# + +package Sip::Configuration::Service; + +use strict; +use warnings; +use English; +use Exporter; + +sub new { + my ($class, $obj) = @_; + my $type = ref($class) || $class; + + if (ref($obj) eq "HASH") { + # Just bless the object + return bless $obj, $type; + } + + return bless {}, $type; +} + +1; diff --git a/C4/SIP/Sip/Constants.pm b/C4/SIP/Sip/Constants.pm new file mode 100644 index 0000000000..f21004641e --- /dev/null +++ b/C4/SIP/Sip/Constants.pm @@ -0,0 +1,339 @@ +# +# Sip::Constants.pm +# +# Various protocol constant values for 3M's Standard Interchange +# Protocol for communication between a library's Automated +# Checkout System (ACS) and stand-alone Self-Check (SC) units + +package Sip::Constants; + +use strict; +use warnings; +use Exporter; + +our (@ISA, @EXPORT_OK, %EXPORT_TAGS); + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(PATRON_STATUS_REQ CHECKOUT CHECKIN BLOCK_PATRON + SC_STATUS REQUEST_ACS_RESEND LOGIN PATRON_INFO + END_PATRON_SESSION FEE_PAID ITEM_INFORMATION + ITEM_STATUS_UPDATE PATRON_ENABLE HOLD RENEW + RENEW_ALL PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS REQUEST_SC_RESEND + LOGIN_RESP PATRON_INFO_RESP END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP PATRON_ENABLE_RESP + HOLD_RESP RENEW_RESP RENEW_ALL_RESP + REQUEST_ACS_RESEND_CKSUM REQUEST_SC_RESEND_CKSUM + FID_PATRON_ID FID_ITEM_ID FID_TERMINAL_PWD + FID_PATRON_PWD FID_PERSONAL_NAME FID_SCREEN_MSG + FID_PRINT_LINE FID_DUE_DATE FID_TITLE_ID + FID_BLOCKED_CARD_MSG FID_LIBRARY_NAME + FID_TERMINAL_LOCN FID_INST_ID FID_CURRENT_LOCN + FID_PERM_LOCN FID_HOLD_ITEMS FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS FID_FINE_ITEMS FID_SEQNO + FID_CKSUM FID_HOME_ADDR FID_EMAIL FID_HOME_PHONE + FID_OWNER FID_CURRENCY FID_CANCEL + FID_TRANSACTION_ID FID_VALID_PATRON + FID_RENEWED_ITEMS FID_UNRENEWED_ITEMS FID_FEE_ACK + FID_START_ITEM FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN FID_FEE_TYPE FID_RECALL_ITEMS + FID_FEE_AMT FID_EXPIRATION FID_SUPPORTED_MSGS + FID_HOLD_TYPE FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT FID_CHARGED_ITEMS_LMT + FID_FEE_LMT FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN FID_FEE_ID FID_ITEM_PROPS + FID_SECURITY_INHIBIT FID_RECALL_DATE + FID_MEDIA_TYPE FID_SORT_BIN FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD FID_LOCATION_CODE + FID_VALID_PATRON_PWD + + FID_PATRON_BIRTHDATE FID_PATRON_CLASS FID_INET_PROFILE + + SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN + SIP_DATETIME); + +%EXPORT_TAGS = ( + + SC_msgs => [qw(PATRON_STATUS_REQ CHECKOUT CHECKIN + BLOCK_PATRON SC_STATUS + REQUEST_ACS_RESEND LOGIN + PATRON_INFO + END_PATRON_SESSION FEE_PAID + ITEM_INFORMATION + ITEM_STATUS_UPDATE + PATRON_ENABLE HOLD RENEW + RENEW_ALL)], + + ACS_msgs => [qw(PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS + REQUEST_SC_RESEND LOGIN_RESP + PATRON_INFO_RESP + END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP + PATRON_ENABLE_RESP HOLD_RESP + RENEW_RESP RENEW_ALL_RESP)], + + constant_msgs => [qw(REQUEST_ACS_RESEND_CKSUM + REQUEST_SC_RESEND_CKSUM)], + + field_ids => [qw( FID_PATRON_ID FID_ITEM_ID + FID_TERMINAL_PWD + FID_PATRON_PWD + FID_PERSONAL_NAME + FID_SCREEN_MSG + FID_PRINT_LINE FID_DUE_DATE + FID_TITLE_ID + FID_BLOCKED_CARD_MSG + FID_LIBRARY_NAME + FID_TERMINAL_LOCN + FID_INST_ID + FID_CURRENT_LOCN + FID_PERM_LOCN + FID_HOLD_ITEMS + FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS + FID_FINE_ITEMS FID_SEQNO + FID_CKSUM FID_HOME_ADDR + FID_EMAIL FID_HOME_PHONE + FID_OWNER FID_CURRENCY + FID_CANCEL + FID_TRANSACTION_ID + FID_VALID_PATRON + FID_RENEWED_ITEMS + FID_UNRENEWED_ITEMS + FID_FEE_ACK FID_START_ITEM + FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN + FID_FEE_TYPE + FID_RECALL_ITEMS + FID_FEE_AMT FID_EXPIRATION + FID_SUPPORTED_MSGS + FID_HOLD_TYPE + FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT + FID_CHARGED_ITEMS_LMT + FID_FEE_LMT + FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN + FID_FEE_ID FID_ITEM_PROPS + FID_SECURITY_INHIBIT + FID_RECALL_DATE + FID_MEDIA_TYPE FID_SORT_BIN + FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD + FID_LOCATION_CODE + FID_VALID_PATRON_PWD + + FID_PATRON_BIRTHDATE + FID_PATRON_CLASS + FID_INET_PROFILE)], + + SC_status => [qw(SC_STATUS_OK SC_STATUS_PAPER + SC_STATUS_SHUTDOWN)], + + formats => [qw(SIP_DATETIME)], + + all => [qw(PATRON_STATUS_REQ CHECKOUT CHECKIN + BLOCK_PATRON SC_STATUS + REQUEST_ACS_RESEND LOGIN PATRON_INFO + END_PATRON_SESSION FEE_PAID + ITEM_INFORMATION ITEM_STATUS_UPDATE + PATRON_ENABLE HOLD RENEW RENEW_ALL + PATRON_STATUS_RESP CHECKOUT_RESP + CHECKIN_RESP ACS_STATUS + REQUEST_SC_RESEND LOGIN_RESP + PATRON_INFO_RESP END_SESSION_RESP + FEE_PAID_RESP ITEM_INFO_RESP + ITEM_STATUS_UPDATE_RESP + PATRON_ENABLE_RESP HOLD_RESP + RENEW_RESP RENEW_ALL_RESP + REQUEST_ACS_RESEND_CKSUM + REQUEST_SC_RESEND_CKSUM FID_PATRON_ID + FID_ITEM_ID FID_TERMINAL_PWD + FID_PATRON_PWD FID_PERSONAL_NAME + FID_SCREEN_MSG FID_PRINT_LINE + FID_DUE_DATE FID_TITLE_ID + FID_BLOCKED_CARD_MSG FID_LIBRARY_NAME + FID_TERMINAL_LOCN FID_INST_ID + FID_CURRENT_LOCN FID_PERM_LOCN + FID_HOLD_ITEMS FID_OVERDUE_ITEMS + FID_CHARGED_ITEMS FID_FINE_ITEMS + FID_SEQNO FID_CKSUM FID_HOME_ADDR + FID_EMAIL FID_HOME_PHONE FID_OWNER + FID_CURRENCY FID_CANCEL + FID_TRANSACTION_ID FID_VALID_PATRON + FID_RENEWED_ITEMS FID_UNRENEWED_ITEMS + FID_FEE_ACK FID_START_ITEM + FID_END_ITEM FID_QUEUE_POS + FID_PICKUP_LOCN FID_FEE_TYPE + FID_RECALL_ITEMS FID_FEE_AMT + FID_EXPIRATION FID_SUPPORTED_MSGS + FID_HOLD_TYPE FID_HOLD_ITEMS_LMT + FID_OVERDUE_ITEMS_LMT + FID_CHARGED_ITEMS_LMT FID_FEE_LMT + FID_UNAVAILABLE_HOLD_ITEMS + FID_HOLD_QUEUE_LEN FID_FEE_ID + FID_ITEM_PROPS FID_SECURITY_INHIBIT + FID_RECALL_DATE FID_MEDIA_TYPE + FID_SORT_BIN FID_HOLD_PICKUP_DATE + FID_LOGIN_UID FID_LOGIN_PWD + FID_LOCATION_CODE FID_VALID_PATRON_PWD + FID_PATRON_BIRTHDATE FID_PATRON_CLASS + FID_INET_PROFILE + SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN + SIP_DATETIME + )]); + +# +# Declare message types +# + +# Messages from SC to ACS +use constant { + PATRON_STATUS_REQ => '23', + CHECKOUT => '11', + CHECKIN => '09', + BLOCK_PATRON => '01', + SC_STATUS => '99', + REQUEST_ACS_RESEND => '97', + LOGIN => '93', + PATRON_INFO => '63', + END_PATRON_SESSION => '35', + FEE_PAID => '37', + ITEM_INFORMATION => '17', + ITEM_STATUS_UPDATE => '19', + PATRON_ENABLE => '25', + HOLD => '15', + RENEW => '29', + RENEW_ALL => '65', +}; + +# Message responses from ACS to SC +use constant { + PATRON_STATUS_RESP => '24', + CHECKOUT_RESP => '12', + CHECKIN_RESP => '10', + ACS_STATUS => '98', + REQUEST_SC_RESEND => '96', + LOGIN_RESP => '94', + PATRON_INFO_RESP => '64', + END_SESSION_RESP => '36', + FEE_PAID_RESP => '38', + ITEM_INFO_RESP => '18', + ITEM_STATUS_UPDATE_RESP => '20', + PATRON_ENABLE_RESP => '26', + HOLD_RESP => '16', + RENEW_RESP => '30', + RENEW_ALL_RESP => '66', +}; + +# +# Some messages are short and invariant, so they're constant's too +# +use constant { + REQUEST_ACS_RESEND_CKSUM => '97AZFEF5', + REQUEST_SC_RESEND_CKSUM => '96AZFEF6', +}; + +# +# Field Identifiers +# +use constant { + FID_PATRON_ID => 'AA', + FID_ITEM_ID => 'AB', + FID_TERMINAL_PWD => 'AC', + FID_PATRON_PWD => 'AD', + FID_PERSONAL_NAME => 'AE', + FID_SCREEN_MSG => 'AF', + FID_PRINT_LINE => 'AG', + FID_DUE_DATE => 'AH', + # UNUSED AI + FID_TITLE_ID => 'AJ', + # UNUSED AK + FID_BLOCKED_CARD_MSG => 'AL', + FID_LIBRARY_NAME => 'AM', + FID_TERMINAL_LOCN => 'AN', + FID_INST_ID => 'AO', + FID_CURRENT_LOCN => 'AP', + FID_PERM_LOCN => 'AQ', + # UNUSED AR + FID_HOLD_ITEMS => 'AS', # SIP 2.0 + FID_OVERDUE_ITEMS => 'AT', # SIP 2.0 + FID_CHARGED_ITEMS => 'AU', # SIP 2.0 + FID_FINE_ITEMS => 'AV', # SIP 2.0 + # UNUSED AW + # UNUSED AX + FID_SEQNO => 'AY', + FID_CKSUM => 'AZ', + + # SIP 2.0 Fields + # UNUSED BA + # UNUSED BB + # UNUSED BC + FID_HOME_ADDR => 'BD', + FID_EMAIL => 'BE', + FID_HOME_PHONE => 'BF', + FID_OWNER => 'BG', + FID_CURRENCY => 'BH', + FID_CANCEL => 'BI', + # UNUSED BJ + FID_TRANSACTION_ID => 'BK', + FID_VALID_PATRON => 'BL', + FID_RENEWED_ITEMS => 'BM', + FID_UNRENEWED_ITEMS => 'BN', + FID_FEE_ACK => 'BO', + FID_START_ITEM => 'BP', + FID_END_ITEM => 'BQ', + FID_QUEUE_POS => 'BR', + FID_PICKUP_LOCN => 'BS', + FID_FEE_TYPE => 'BT', + FID_RECALL_ITEMS => 'BU', + FID_FEE_AMT => 'BV', + FID_EXPIRATION => 'BW', + FID_SUPPORTED_MSGS => 'BX', + FID_HOLD_TYPE => 'BY', + FID_HOLD_ITEMS_LMT => 'BZ', + FID_OVERDUE_ITEMS_LMT => 'CA', + FID_CHARGED_ITEMS_LMT => 'CB', + FID_FEE_LMT => 'CC', + FID_UNAVAILABLE_HOLD_ITEMS => 'CD', + # UNUSED CE + FID_HOLD_QUEUE_LEN => 'CF', + FID_FEE_ID => 'CG', + FID_ITEM_PROPS => 'CH', + FID_SECURITY_INHIBIT => 'CI', + FID_RECALL_DATE => 'CJ', + FID_MEDIA_TYPE => 'CK', + FID_SORT_BIN => 'CL', + FID_HOLD_PICKUP_DATE => 'CM', + FID_LOGIN_UID => 'CN', + FID_LOGIN_PWD => 'CO', + FID_LOCATION_CODE => 'CP', + FID_VALID_PATRON_PWD => 'CQ', + + # SIP Extensions used by Envisionware Terminals + FID_PATRON_BIRTHDATE => 'PB', + FID_PATRON_CLASS => 'PC', + + # SIP Extension for reporting patron internet privileges + FID_INET_PROFILE => 'PI', +}; + +# +# SC Status Codes +# +use constant { + SC_STATUS_OK => '0', + SC_STATUS_PAPER => '1', + SC_STATUS_SHUTDOWN => '2', +}; + +# +# Various format strings +# +use constant { + SIP_DATETIME => "%Y%m%d %H%M%S", +}; diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm new file mode 100644 index 0000000000..ce05b93ce8 --- /dev/null +++ b/C4/SIP/Sip/MsgType.pm @@ -0,0 +1,1577 @@ +# +# Sip::MsgType.pm +# +# A Class for handing SIP messages +# + +package Sip::MsgType; + +use strict; +use warnings; +use Exporter; +use Sys::Syslog qw(syslog); +use UNIVERSAL qw(can); + +use Sip qw(:all); +use Sip::Constants qw(:all); +use Sip::Checksum qw(verify_cksum); + +use Data::Dumper; + +our (@ISA, @EXPORT_OK); + +@ISA = qw(Exporter); +@EXPORT_OK = qw(handle); + +# 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 => "A18A2A3", + template_len => 0, + 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); + + syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s', '%s'): msgtag '%s'", + $class, substr($msg, 0, 10), $msgtag, $seqno); + 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, + # so we'll just do it. + $protocol_version = 2; + } + 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} = []; + + syslog("LOG_DEBUG", "Sip::MsgType:_initialize('%s', '%s...')", + $self->{name}, substr($msg, 0, 20)); + + 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) ]; + + # 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've receive 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); + } + return($self->{handler}->($self, $server)); +} + +## +## 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'); + # If the patron password field doesn't exist, then + # we can't report that the password was valid, now can + # we? But if it does exist, then we know it's valid. + if (defined($patron_pwd)) { + $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)}); + + if ($protocol_version >= 2) { + $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 ($lang, $date); + my $fields; + my $patron; + my $resp = (PATRON_STATUS_RESP); + my $account = $server->{account}; + + ($lang, $date) = @{$self->{fixed_fields}}; + $fields = $self->{fields}; + + $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_WARN", "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); + } 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 + $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 ($no_block, $trans_date, $return_date); + my $fields; + my ($current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel); + my $resp = CHECKIN_RESP; + my ($patron, $item); + my $status; + + ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}}; + $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_WARN", "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); + } else { + # The item barcode was invalid or the system doesn't support + # the 'magnetic media' indicator + $resp .= 'U'; + } + $resp .= $status->alert ? 'Y' : 'N'; + $resp .= Sip::timestamp; + $resp .= add_field(FID_INST_ID, $inst_id); + $resp .= add_field(FID_ITEM_ID, $item_id); + + 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_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; + my $resp; + my $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. + + $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) = @_; + my ($status, $print_width, $sc_protocol_version, $new_proto); + + ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}}; + + 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_WARN", "Self-Check unit '%s@%s' out of paper", + $self->{account}->{id}, $self->{account}->{institution}); + } elsif ($status == SC_STATUS_SHUTDOWN) { + syslog("LOG_WARN", "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"); + } else { + my $rebuilt; + + # Cut out the sequence number and checksum, since the old + # checksum is wrong for the resent message. + $rebuilt = substr($last_response, 0, -9); + $self->write_msg($rebuilt); + } + + return REQUEST_ACS_RESEND; +} + +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)}; + $pwd = $fields->{(FID_LOGIN_PWD)}; + + if ($uid_algorithm || $pwd_algorithm) { + syslog("LOG_ERR", "LOGIN: Can't cope with non-zero encryption methods: uid = $uid_algorithm, pwd = $pwd_algorithm"); + $status = 0; + } + + if (!exists($server->{config}->{accounts}->{$uid})) { + syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'"); + $status = 0; + } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) { + syslog("LOG_WARNING", + "MsgType::handle_login: 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}; + $inst = $server->{account}->{institution}; + $server->{institution} = $server->{config}->{institutions}->{$inst}; + $server->{policy} = $server->{institution}->{policy}; + + + syslog("LOG_INFO", "Successful login for '%s' of '%s'", + $server->{account}->{id}, $inst); + # + # initialize connection to ILS + # + my $module = $server->{config} + ->{institutions} + ->{ $inst } + ->{implementation}; + $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'"); + } + + $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'"); + } + } + + $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 $itemlist; + my $summary_type; + my ($func, $fid); + # + # 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) { + # No detailed information required + return ''; + } + + syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'", + $summary_type, $summary_map[$summary_type]->{fid}); + + $func = $summary_map[$summary_type]->{func}; + $fid = $summary_map[$summary_type]->{fid}; + $itemlist = &$func($patron, $start, $end); + + syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist})); + foreach my $i (@{$itemlist}) { + $resp .= add_field($fid, $i); + } + + 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 .= $lang . 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}); + + # 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 + # fee limit + + $resp .= maybe_add(FID_CURRENCY, $patron->currency); + $resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount); + + $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); + + $resp .= summary_info($ils, $patron, $summary, $start, $end); + + $resp .= add_field(FID_VALID_PATRON, 'Y'); + if (defined($patron_pwd)) { + # If the patron password was provided, report on if + # it was right. + $resp .= add_field(FID_VALID_PATRON_PWD, + sipbool($patron->check_password($patron_pwd))); + } + + # SIP 2.0 extensions used by Envisionware + # Other types of terminals will ignore the fields, if + # they don't recognize the codes + $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->sip_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 + # He has no privileges, no items associated with him, + # no personal name, and is invalid (if we're using 2.00) + $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp(); + $resp .= '0000' x 6; + $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)}); + + if ($protocol_version >= 2) { + $resp .= add_field(FID_VALID_PATRON, 'N'); + } + } + + $resp .= add_field(FID_INST_ID, $server->{ils}->institution); + + $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) { + $resp .= add_field(FID_DUE_DATE, Sip::timestamp($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; + $status->screen_msg("System error. Please contact library status"); + } + + $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); + + if ($status->expiration_date) { + $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 ($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; + + if ($status->ok) { + $resp .= '1'; + $resp .= $status->renewal_ok ? 'Y' : 'N'; + if ($ils->supports('magnetic media')) { + $resp .= sipbool($item->magnetic); + } 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); + $resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->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 ($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; + my $account = $server->{account}; + my $policy = $server->{policy}; + my $ils = $server->{ils}; + 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_ERROR", + '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_ERROR", '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; +} + +1; diff --git a/C4/SIP/acstest.py b/C4/SIP/acstest.py new file mode 100644 index 0000000000..02eb4bd272 --- /dev/null +++ b/C4/SIP/acstest.py @@ -0,0 +1,42 @@ +import operator +import socket +from time import strftime; + +def SipSocket(host='localhost', port=5300): + so = socket.socket() + so.connect((host, port)) + return so + +def login(so, uname='scclient', passwd='clientpwd', locn='The basement', + seqno=0): + port = so.getpeername()[1] + if port == 5300: + resp = send(so, '9300CN%s|CO%s|CP%s|' % (uname, passwd, locn), seqno) + print "Received", repr(resp) + print "Verified: ", verify(resp) + else: + raise "Logging in is only support for the raw transport on port 5300" + +def send(so, msg, seqno=0): + if seqno: + msg += 'AY' + str(seqno)[0] + 'AZ' + msg += ('%04X' % calculate_cksum(msg)) + msg += '\r' + print 'Sending', repr(msg) + so.send(msg) + resp = so.recv(1000) + return resp, verify(resp) + +def calculate_cksum(msg): + return (-reduce(operator.add, map(ord, msg)) & 0xFFFF) + +def sipdate(): + return(strftime("%Y%m%d %H%M%S")) + +def verify(msg): + if msg[-1] == '\r': msg = msg[:-2] + if msg[-6:-4] == 'AZ': + cksum = calculate_cksum(msg[:-4]) + return (msg[-4:] == ('%04X' % cksum)) + # If there's no checksum, then the message is ok + return True diff --git a/C4/SIP/t/00sc_status.t b/C4/SIP/t/00sc_status.t new file mode 100644 index 0000000000..9a4f840fcd --- /dev/null +++ b/C4/SIP/t/00sc_status.t @@ -0,0 +1,26 @@ +#!/usr/bin/perl +# +# sc_status: test basic connection, login, and response +# to the SC Status message, which has to be sent before +# anything else + +use strict; +use warnings; + +use SIPtest qw($datepat $username $password $login_test $sc_status_test); + +my $invalid_uname = { id => 'Invalid username', + msg => "9300CNinvalid$username|CO$password|CPThe floor|", + pat => qr/^940/, + fields => [], }; + +my $invalid_pwd = { id => 'Invalid username', + msg => "9300CN$username|COinvalid$password|CPThe floor|", + pat => qr/^940/, + fields => [], }; + +my @tests = ( $invalid_uname, $invalid_pwd, $login_test, $sc_status_test ); + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/01patron_status.t b/C4/SIP/t/01patron_status.t new file mode 100644 index 0000000000..a00c074f14 --- /dev/null +++ b/C4/SIP/t/01patron_status.t @@ -0,0 +1,80 @@ +#!/usr/bin/perl +# +# patron_status: check status of valid patron and invalid patron + +use strict; +use warnings; + +use Sip::Constants qw(:all); +use SIPtest qw($datepat $instid $currency $user_barcode $user_pin + $user_fullname $user_homeaddr $user_email $user_phone + $user_birthday); + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + { id => 'valid Patron Status', + msg => "2300120060101 084237AO$SIPtest::instid|AA$user_barcode|AD$user_pin|AC|", + pat => qr/^24 [ Y]{13}\d{3}$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PERSONAL_NAME, + pat => qr/^$user_fullname$/o, + required => 1, }, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode/o, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + required => 0, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^Y$/, + required => 0, }, + { field => FID_CURRENCY, + pat => qr/^$currency$/io, + required => 0, }, + { field => FID_FEE_AMT, + pat => qr/^[0-9.]+$/, + required => 0, }, + ], }, + { id => 'invalid password Patron Status', + msg => "2300120060101 084237AO$instid|AA$user_barcode|AC|ADbadw|", + pat => qr/^24[ Y]{14}\d{3}$datepat/, + fields => [ + { field => FID_PERSONAL_NAME, + pat => qr/^$user_fullname$/o, + required => 1, }, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_INST_ID, + pat => qr/^$instid$/o, + required => 1, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^N$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + required => 1, }, + ], }, + { id => 'invalid Patron Status', + msg => "2300120060101 084237AO$instid|AAwshakespeare|AC|", + pat => qr/^24Y[ Y]{13}\d{3}$datepat/, + fields => [ + { field => FID_PERSONAL_NAME, + pat => qr/^$/, + required => 1, }, + { field => FID_PATRON_ID, + pat => qr/^wshakespeare$/, + required => 1, }, + { field => FID_INST_ID, + pat => qr/^$instid$/o, + required => 1, }, + ], }, + ); + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/02patron_info.t b/C4/SIP/t/02patron_info.t new file mode 100644 index 0000000000..292c279532 --- /dev/null +++ b/C4/SIP/t/02patron_info.t @@ -0,0 +1,172 @@ +#!/usr/bin/perl +# patron_info: test Patron Information Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $currency $user_barcode $user_pin + $user_fullname $user_homeaddr $user_email $user_phone + $user_birthday $user_ptype $user_inet); + +# This is a template test case for the Patron Information +# message handling. Because of the large number of fields, +# this template forms the basis for all of the different +# situations: valid patron no details, valid patron with each +# individual detail requested, invalid patron, invalid patron +# password, etc. +my $patron_info_test_template = { + id => 'valid Patron Info no details', + msg => "6300020060329 201700 AO$instid|AA$user_barcode|", + pat => qr/^64 [ Y]{13}\d{3}$datepat(\d{4}){6}/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$user_fullname$/o, + required => 1, }, + $SIPtest::field_specs{(FID_HOLD_ITEMS_LMT)}, + $SIPtest::field_specs{(FID_OVERDUE_ITEMS_LMT)}, + $SIPtest::field_specs{(FID_CHARGED_ITEMS_LMT)}, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + $SIPtest::field_specs{(FID_CURRENCY)}, + { field => FID_FEE_AMT, + pat => $textpat, + required => 0, }, + { field => FID_FEE_LMT, + pat => $textpat, + required => 0, }, + { field => FID_HOME_ADDR, + pat => qr/^$user_homeaddr$/o, + required => 1, }, # required by this test case + { field => FID_EMAIL, + pat => qr/^$user_email$/o, + required => 1, }, + { field => FID_HOME_PHONE, + pat => qr/^$user_phone$/o, + required => 1, }, + { field => FID_PATRON_BIRTHDATE, + pat => qr/^$user_birthday$/o, + required => 1, }, + { field => FID_PATRON_CLASS, + pat => qr/^$user_ptype$/o, + required => 1, }, + { field => FID_INET_PROFILE, + pat => qr/^$user_inet$/, + required => 1, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + clone($patron_info_test_template), + ); + + +# Create the test cases for the various summary detail fields +sub create_patron_summary_tests { + my $test; + my @patron_info_summary_tests = ( + { field => FID_HOLD_ITEMS, + pat => $textpat, + required => 0, }, + { field => FID_OVERDUE_ITEMS, + pat => $textpat, + required => 0, }, + { field => FID_CHARGED_ITEMS, + pat => $textpat, + required => 0, }, +# The test user has no items of these types, so the tests seem to fail +# { field => FID_FINE_ITEMS, +# pat => $textpat, +# required => 1, }, +# { field => FID_RECALL_ITEMS, +# pat => $textpat, +# required => 0, }, +# { field => FID_UNAVAILABLE_HOLD_ITEMS, +# pat => $textpat, +# required => 0, }, + ); + + foreach my $i (0 .. scalar @patron_info_summary_tests-1) { + # The tests for each of the summary fields are exactly the + # same as the basic one, except for the fact that there's + # an extra field to test + + # Copy the hash, adjust it, add it to the end of the list + $test = clone($patron_info_test_template); + + substr($test->{msg}, 23+$i, 1) = 'Y'; + $test->{id} = "valid Patron Info details: " + . $patron_info_summary_tests[$i]->{field}; + push @{$test->{fields}}, $patron_info_summary_tests[$i]; + push @tests, $test; + } +} + +sub create_invalid_patron_tests { + my $test; + + $test = clone($patron_info_test_template); + $test->{id} = "invalid Patron Info id"; + $test->{msg} =~ s/AA$user_barcode\|/AAberick|/o; + $test->{pat} = qr/^64Y[ Y]{13}\d{3}$datepat(\d{4}){6}/; + delete $test->{fields}; + $test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^berick$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^N$/, + required => 1, }, + ]; + push @tests, $test; + + # Valid patron, invalid patron password + $test = clone($patron_info_test_template); + $test->{id} = "valid Patron Info, invalid password"; + $test->{msg} .= (FID_PATRON_PWD) . 'badpwd|'; + $test->{pat} = qr/^64[ Y]{14}\d{3}$datepat(\d{4}){6}/; + delete $test->{fields}; + $test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$user_fullname$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + required => 1, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^N$/, + required => 1, }, + ]; + push @tests, $test; +} + +create_patron_summary_tests; + +create_invalid_patron_tests; + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/03checkout.t b/C4/SIP/t/03checkout.t new file mode 100644 index 0000000000..da9dd28b16 --- /dev/null +++ b/C4/SIP/t/03checkout.t @@ -0,0 +1,209 @@ +#!/usr/bin/perl +# checkout: test Checkout Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $currency $user_barcode + $item_barcode $item_title + $item_diacritic_barcode $item_diacritic_title + $item_diacritic_owner); + +my $patron_enable_template = { + id => 'Renew All: prep: enable patron permissions', + msg => "2520060102 084238AO$instid|AA$user_barcode|", + pat => qr/^26 {4}[ Y]{10}000$datepat/o, + fields => [], +}; + +my $patron_disable_template = { + id => 'Checkout: block patron (prep to test checkout denied)', + msg => "01N20060102 084238AO$instid|ALHe's a jerk|AA$user_barcode|", + # response to block patron is a patron status message + pat => qr/^24Y{4}[ Y]{10}000$datepat/o, + fields => [], }; + +my $checkin_template = { + id => 'Checkout: cleanup: check in item', + msg => "09N20050102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|", + pat => qr/^101YNN$datepat/o, + fields => [], + }; + +my $checkout_test_template = { + id => 'Checkout: valid item, valid patron', + msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|", + pat => qr/^121NNY$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$item_barcode$/o, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$item_title\s*$/o, + required => 1, }, + { field => FID_DUE_DATE, + pat => $textpat, + required => 1, }, + { field => FID_FEE_TYPE, + pat => qr/^\d{2}$/, + required => 0, }, + { field => FID_SECURITY_INHIBIT, + pat => qr/^[YN]$/, + required => 0, }, + { field => FID_CURRENCY, + pat => qr/^$currency$/o, + required => 0, }, + { field => FID_FEE_AMT, + pat => qr/^[.0-9]+$/, + required => 0, }, + { field => FID_MEDIA_TYPE, + pat => qr/^\d{3}$/, + required => 0, }, + { field => FID_ITEM_PROPS, + pat => $textpat, + required => 0, }, + { field => FID_TRANSACTION_ID, + pat => $textpat, + required => 0, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + clone($checkout_test_template), + # Don't check the item in, because we're about to test renew + ); + +my $test; + +## Renewal OK +## Test this by checking out exactly the same book a second time. +## The only difference should be that the "Renewal OK" flag should now +## be 'Y'. +#$test = clone($checkout_test_template); +#$test->{id} = 'Checkout: patron renewal'; +#$test->{pat} = qr/^121YNY$datepat/; +# +#push @tests, $test; + +# NOW check it in + +push @tests, $checkin_template; + +# Valid Patron, item with diacritical in the title +$test = clone($checkout_test_template); + +$test->{id} = 'Checkout: valid patron, diacritical character in title'; +$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/; + +foreach my $i (0 .. (scalar @{$test->{fields}})-1) { + my $field = $test->{fields}[$i]; + + if ($field->{field} eq FID_ITEM_ID) { + $field->{pat} = qr/^$item_diacritic_barcode$/; + } elsif ($field->{field} eq FID_TITLE_ID) { + $field->{pat} = qr/^$item_diacritic_title\s*$/; + } elsif ($field->{field} eq FID_OWNER) { + $field->{pat} = qr/^$item_diacritic_owner$/; + } +} + +push @tests, $test; + +$test = clone($checkin_template); +$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/; +push @tests, $test; + +# Valid Patron, Invalid Item_id +$test = clone($checkout_test_template); + +$test->{id} = 'Checkout: valid patron, invalid item'; +$test->{msg} =~ s/AB$item_barcode/ABno-barcode/o; +$test->{pat} = qr/^120NUN$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^no-barcode$/, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$/, + required => 1, }, + { field => FID_DUE_DATE, + pat => qr/^$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + required => 1, }, + ]; + +push @tests, $test; + +# Invalid patron, valid item +$test = clone($checkout_test_template); +$test->{id} = 'Checkout: invalid patron, valid item'; +$test->{msg} =~ s/AA$user_barcode/AAberick/; +$test->{pat} = qr/^120NUN$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^berick$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$item_barcode$/o, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$item_title\s*$/o, + required => 1, }, + { field => FID_DUE_DATE, + pat => qr/^$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^N$/, + required => 1, }, + ]; + +push @tests, $test; + +# Needed: tests for blocked patrons, patrons with excessive +# fines/fees, magnetic media, charging fees to borrow items. + +## Blocked patron +#$test = clone($checkout_test_template); +#$test->{id} = 'Checkout: Blocked patron'; +#$test->{pat} = qr/^120NUN$datepat/; +#delete $test->{fields}; +#$test->{fields} = [ +# $SIPtest::field_specs{(FID_INST_ID)}, +# $SIPtest::field_specs{(FID_SCREEN_MSG)}, +# $SIPtest::field_specs{(FID_PRINT_LINE)}, +# { field => FID_PATRON_ID, +# pat => qr/^$user_barcode$/, +# required => 1, }, +# { field => FID_VALID_PATRON, +# pat => qr/^Y$/, +# required => 1, }, +# ]; +# +#push @tests, $patron_disable_template, $test, $patron_enable_template; +# +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/04patron_status.t b/C4/SIP/t/04patron_status.t new file mode 100644 index 0000000000..ebec04ecc3 --- /dev/null +++ b/C4/SIP/t/04patron_status.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl +# patron_status: test Patron Status Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat); + +my $patron_status_test_template = { + id => 'Patron Status: valid patron, no patron password', + msg => '2300120060101 084237AOUWOLS|AAdjfiander|ACterminal password|', + pat => qr/^24 [ Y]{13}001$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + $SIPtest::field_specs{(FID_CURRENCY)}, + { field => FID_FEE_AMT, + pat => $textpat, + required => 0, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + clone($patron_status_test_template), + ); + +# Invalid patron +my $test = clone($patron_status_test_template); + +$test->{id} = 'Patron Status invalid id'; +$test->{msg} =~ s/AAdjfiander\|/AAberick|/; + +# The test assumes that the language sent by the terminal is +# just echoed back for invalid patrons. +$test->{pat} = qr/^24Y[ Y]{13}001$datepat/; + +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^berick$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^N$/, + required => 1, }, + ]; + +push @tests, $test; + +# Valid patron, invalid patron password +$test = clone($patron_status_test_template); +$test->{id} = 'Patron Status: Valid patron, invalid patron password'; +$test->{msg} .= (FID_PATRON_PWD) . 'badpwd|'; +$test->{pat} = qr/^24[ Y]{14}001$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + required => 1, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^N$/, + required => 1, }, + ]; +push @tests, $test; + +# TODO: Need multiple patrons to test each individual +# status field + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/05block_patron.t b/C4/SIP/t/05block_patron.t new file mode 100644 index 0000000000..3bdbdb27ac --- /dev/null +++ b/C4/SIP/t/05block_patron.t @@ -0,0 +1,45 @@ +#!/usr/bin/perl +# block_patron: test Block Patron Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $user_barcode $user_fullname); + +my $block_patron_test_template = { + id => 'Block Patron: valid patron, card not retained', + msg => "01N20060102 084238AO$instid|ALHe's a jerk|AA$user_barcode|ACterminal password|", + # response to block patron is a patron status message + pat => qr/^24Y[ Y]{13}000$datepat/o, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$user_fullname$/o, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + $SIPtest::field_specs{(FID_CURRENCY)}, + { field => FID_FEE_AMT, + pat => $textpat, + required => 0, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + clone($block_patron_test_template), + ); + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/06patron_enable.t b/C4/SIP/t/06patron_enable.t new file mode 100644 index 0000000000..56486c053b --- /dev/null +++ b/C4/SIP/t/06patron_enable.t @@ -0,0 +1,144 @@ +#!/usr/bin/perl +# patron_enable: test Patron Enable Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat); + +my $patron_enable_test_template = { + id => 'Patron Enable: valid patron', + msg => "2520060102 084238AOUWOLS|AAdjfiander|", + pat => qr/^26 {4}[ Y]{10}000$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + ], }; + +# We need to disable the valid patron before we can +# ensure that he was properly enabled. +my $patron_disable_test_template = { + id => 'Patron Enable: block patron (prep to test enabling)', + msg => "01N20060102 084238AOUWOLS|ALHe's a jerk|AAdjfiander|", + # response to block patron is a patron status message + pat => qr/^24Y{4}[ Y]{10}000$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + $patron_disable_test_template, + clone($patron_enable_test_template), + ); + +my $test; + +# Valid patron, valid password +$test = clone($patron_enable_test_template); +$test->{id} = "Patron Enable: valid patron, valid password"; +$test->{msg} .= FID_PATRON_PWD . '6789|'; +$test->{pat} = qr/^26 {4}[ Y]{10}000$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^Y$/, + required => 1, }, + ]; + +push @tests, $patron_disable_test_template, $test; + +# Valid patron, invalid password +$test = clone($patron_enable_test_template); +$test->{id} = "Patron Enable: valid patron, invalid password"; +$test->{msg} .= FID_PATRON_PWD . 'bad password|'; +$test->{pat} = qr/^26[ Y]{14}000$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^David J\. Fiander$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^Y$/, + # Not required by the spec, but by the test + required => 1, }, + { field => FID_VALID_PATRON_PWD, + pat => qr/^N$/, + required => 1, }, + ]; + +push @tests, $patron_disable_test_template, $test; +# After this test, the patron is left disabled, so re-enable +push @tests, $patron_enable_test_template; + +# Invalid patron +$test = clone($patron_enable_test_template); +$test->{id} =~ s/valid/invalid/; +$test->{msg} =~ s/AAdjfiander\|/AAberick|/; +$test->{pat} = qr/^26Y{4}[ Y]{10}000$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^berick$/, + required => 1, }, + { field => FID_PERSONAL_NAME, + pat => qr/^$/, + required => 1, }, + { field => FID_VALID_PATRON, + pat => qr/^N$/, + # Not required by the spec, but by the test + required => 1, }, + ]; + +push @tests, $test; + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/07hold.t b/C4/SIP/t/07hold.t new file mode 100644 index 0000000000..bddb31218a --- /dev/null +++ b/C4/SIP/t/07hold.t @@ -0,0 +1,187 @@ +#!/usr/bin/perl +# patron_enable: test Patron Enable Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat); + +my $hold_test_template = { + id => 'Place Hold: valid item, valid patron', + msg => '15+20060415 110158BW20060815 110158|BSTaylor|BY2|AOUWOLS|AAdjfiander|AB1565921879|', + pat => qr/^161N$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_EXPIRATION, + pat => $datepat, + required => 0, }, + { field => FID_QUEUE_POS, + pat => qr/^1$/, + required => 1, }, + { field => FID_PICKUP_LOCN, + pat => qr/^Taylor$/, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^Perl 5 desktop reference$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^1565921879$/, + required => 1, }, + ],}; + +my $hold_count_test_template0 = { + id => 'Confirm patron has 0 holds', + msg => '6300020060329 201700 AOUWOLS|AAdjfiander|', + pat => qr/^64 [ Y]{13}\d{3}${datepat}0000(\d{4}){5}/, + fields => [], +}; + +my $hold_count_test_template1 = { + id => 'Confirm patron has 1 hold', + msg => '6300020060329 201700 AOUWOLS|AAdjfiander|', + pat => qr/^64 [ Y]{13}\d{3}${datepat}0001(\d{4}){5}/, + fields => [], +}; + + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + $hold_test_template, $hold_count_test_template1, + ); + +my $test; + +# Hold Queue: second hold placed on item +$test = clone($hold_test_template); +$test->{id} = 'Place hold: second hold on item'; +$test->{msg} =~ s/djfiander/miker/; +$test->{pat} = qr/^161N$datepat/; +foreach my $i (0 .. (scalar @{$test->{fields}})-1) { + my $field = $test->{fields}[$i]; + + if ($field->{field} eq FID_PATRON_ID) { + $field->{pat} = qr/^miker$/; + } elsif ($field->{field} eq FID_QUEUE_POS) { + $field->{pat} = qr/^2$/; + } +} + +push @tests, $test; + +# Cancel hold: valid hold +$test = clone($hold_test_template); +$test->{id} = 'Cancel hold: valid hold'; +$test->{msg} =~ s/\+/-/; +$test->{pat} = qr/^161[NY]$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + ]; + +push @tests, $test, $hold_count_test_template0; + +# Cancel Hold: no hold on item +# $test is already set up to cancel a hold, just change +# the field tests +$test = clone($test); +$test->{id} = 'Cancel Hold: no hold on specified item'; +$test->{pat} = qr/^160N$datepat/; + +push @tests, $test, $hold_count_test_template0; + +# Cleanup: cancel miker's hold too. +$test = clone($hold_test_template); +$test->{id} = "Cancel hold: cleanup second patron's hold"; +$test->{msg} =~ s/\+/-/; +$test->{msg} =~ s/djfiander/miker/; +$test->{pat} = qr/^161[NY]$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^miker$/, + required => 1, }, + ]; + +push @tests, $test; + +# Place hold: valid patron, item, invalid patron pwd +$test = clone($hold_test_template); +$test->{id} = 'Place hold: invalid patron password'; +$test->{msg} .= FID_PATRON_PWD . 'bad password|'; +$test->{pat} = qr/^160N$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + ]; + +push @tests, $test, $hold_count_test_template0; + +# Place hold: invalid patron +$test = clone($hold_test_template); +$test->{id} = 'Place hold: invalid patron'; +$test->{msg} =~ s/AAdjfiander\|/AAberick|/; +$test->{pat} = qr/^160N$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^berick$/, + required => 1, }, + ]; + +# There's no patron to check the number of holds against +push @tests, $test; + +# Place hold: invalid item +$test = clone($hold_test_template); +$test->{id} = 'Place hold: invalid item'; +$test->{msg} =~ s/AB1565921879\|/ABnosuchitem|/; +$test->{pat} = qr/^160N$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^djfiander$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^nosuchitem$/, + required => 0, }, + ]; + +push @tests, $test, $hold_count_test_template0; + +# Still need tests for: +# - valid patron not permitted to place holds +# - valid item, not allowed to hold item +# - multiple holds on item: correct queue position management +# - setting and verifying hold expiry dates (requires ILS support) + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/08checkin.t b/C4/SIP/t/08checkin.t new file mode 100644 index 0000000000..395cda5171 --- /dev/null +++ b/C4/SIP/t/08checkin.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl +# checkin: test Checkin Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $user_barcode + $item_barcode $item_title); + +my $checkin_test_template = { + id => 'Checkin: Item is checked out', + msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|", + pat => qr/^101YNN$datepat/o, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/o, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$item_barcode$/o, + required => 1, }, + { field => FID_PERM_LOCN, + pat => $textpat, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$item_title\s*$/o, + required => 1, }, # not required by the spec. + ],}; + +my $checkout_template = { + id => 'Checkin: prep: check out item', + msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|", + pat => qr/^121NNY$datepat/o, + fields => [], +}; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + $checkout_template, + $checkin_test_template, + ); + +my $test; + +# Checkin item that's not checked out. Basically, this +# is identical to the first case, except the header says that +# the ILS didn't check the item in, and there's no patron id. +$test = clone($checkin_test_template); +$test->{id} = 'Checkin: Item not checked out'; +$test->{pat} = qr/^100YNN$datepat/o; +$test->{fields} = [grep $_->{field} ne FID_PATRON_ID, @{$test->{fields}}]; + +push @tests, $test; + +# +# Still need tests for magnetic media +# + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/09renew.t b/C4/SIP/t/09renew.t new file mode 100644 index 0000000000..ad9fb06640 --- /dev/null +++ b/C4/SIP/t/09renew.t @@ -0,0 +1,147 @@ +#!/usr/bin/perl +# renew: test Renew Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $currency $user_barcode + $item_barcode $item_title); + +my $checkout_template = { + id => 'Renew: prep: check out item', + msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|", + pat => qr/^121NNY$datepat/, + fields => [], + }; + +my $checkin_template = { + id => 'Renew: prep: check in item', + msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|", + pat => qr/^101YNN$datepat/, + fields => [], + }; + +#my $hold_template = { +# id => 'Renew: prep: place hold on item', +# msg =>"15+20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|", +# pat => qr/^161N$datepat/, +# fields => [], +# }; +# +#my $cancel_hold_template = { +# id => 'Renew: cleanup: cancel hold on item', +# msg =>"15-20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|", +# pat => qr/^161[NY]$datepat/, +# fields => [], +# }; +# + +my $renew_test_template = { + id => 'Renew: item id checked out to patron, renewal permitted, no 3rd party, no fees', + msg => "29NN20060102 084236 AO$instid|AA$user_barcode|AB$item_barcode|", + pat => qr/^301YNN$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_PATRON_ID, + pat => qr/^$user_barcode$/, + required => 1, }, + { field => FID_ITEM_ID, + pat => qr/^$item_barcode$/, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$item_title\s*$/, + required => 1, }, + { field => FID_DUE_DATE, + pat => qr/^$datepat$/, + required => 1, }, + { field => FID_SECURITY_INHIBIT, + pat => qr/^[YN]$/, + required => 0, }, + ],}; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + $checkout_template, + $renew_test_template, + ); + +my $test; + +# Renew: item checked out, identify by title +#$test = clone($renew_test_template); +#$test->{id} = 'Renew: identify item by title'; +#$test->{msg} =~ s/AB$item_barcode\|/AJ$item_title|/; +## Everything else should be the same +#push @tests, $test; +# +## Renew: Item checked out, but another patron has placed a hold +#$test = clone($renew_test_template); +#$test->{id} = 'Renew: Item has outstanding hold'; +#$test->{pat} = qr/^300NUN$datepat/; +#foreach my $field (@{$test->{fields}}) { +# if ($field->{field} eq FID_DUE_DATE || $field->{field} eq FID_TITLE_ID) { +# $field->{pat} = qr/^$/; +# } +#} +# +#push @tests, $hold_template, $test, $cancel_hold_template; +# +# Renew: item not checked out. Basically the same, except +# for the leader test. +$test = clone($renew_test_template); +$test->{id} = 'Renew: item not checked out at all'; +$test->{pat} = qr/^300NUN$datepat/; +foreach my $field (@{$test->{fields}}) { + if ($field->{field} eq FID_DUE_DATE) { + $field->{pat} = qr/^$/; + } elsif ($field->{field} eq FID_TITLE_ID) { + $field->{pat} = qr/^($item_title\s*|)$/; + } +} + +push @tests, $checkin_template, $test; + +$test = clone($renew_test_template); +$test->{id} = 'Renew: Invalid item'; +$test->{msg} =~ s/AB[^|]+/ABbad-item/; +$test->{pat} = qr/^300NUN$datepat/; +foreach my $field (@{$test->{fields}}) { + if ($field->{field} eq FID_TITLE_ID || $field->{field} eq FID_DUE_DATE) { + $field->{pat} = qr/^$/; + } elsif ($field->{field} eq FID_ITEM_ID) { + $field->{pat} = qr/^bad-item$/; + } +} + +push @tests, $test; + +$test = clone($renew_test_template); +$test->{id} = 'Renew: Invalid user'; +$test->{msg} =~ s/AA$user_barcode/AAberick/; +$test->{pat} = qr/^300NUN$datepat/; +foreach my $field (@{$test->{fields}}) { + if ($field->{field} eq FID_DUE_DATE) { + $field->{pat} = qr/^$/; + } elsif ($field->{field} eq FID_PATRON_ID) { + $field->{pat} = qr/^berick$/; + } elsif ($field->{field} eq FID_TITLE_ID) { + $field->{pat} = qr/^($item_title\s*|)$/; + } +} + +push @tests, $test; + +# Still need tests for +# - renewing a for-fee item +# - patrons that are not permitted to renew +# - renewing item that has reached limit on number of renewals + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/10renew_all.t b/C4/SIP/t/10renew_all.t new file mode 100644 index 0000000000..2cf6ee5bd3 --- /dev/null +++ b/C4/SIP/t/10renew_all.t @@ -0,0 +1,107 @@ +#!/usr/bin/perl +# renew_all: test Renew All Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $user_barcode $item_barcode $item_owner + $item2_barcode $item2_owner $instid); + +my $enable_template = { + id => 'Renew All: prep: enable patron permissions', + msg => "2520060102 084238AO$instid|AA$user_barcode|", + pat => qr/^26 {4}[ Y]{10}000$datepat/, + fields => [], +}; + +my @checkout_templates = ( + { id => "Renew All: prep: check out $item_barcode", + msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|", + pat => qr/^121NNY$datepat/, + fields => [],}, + { id => "Renew All: prep: check out $item2_barcode", + msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item2_barcode|AC|", + pat => qr/^121NNY$datepat/, + fields => [],} + ); + +my @checkin_templates = ( + { id => "Renew All: prep: check in $item_barcode", + msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|", + pat => qr/^101YNN$datepat/, + fields => [],}, + { id => "Renew All: prep: check in $item2_barcode", + msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item2_barcode|ACterminal password|", + pat => qr/^101YNN$datepat/, + fields => [],} + ); + +my $renew_all_test_template = { + id => 'Renew All: valid patron with one item checked out, no patron password', + msg => "6520060102 084236AO$instid|AA$user_barcode|", + pat => qr/^66100010000$datepat/, + fields => [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_RENEWED_ITEMS, + pat => qr/^$item_barcode$/, + required => 1, }, + ],}; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, +# $enable_template, + $checkout_templates[0], + $renew_all_test_template, + $checkin_templates[0], # check the book in, when done testing + ); + +my $test; + +#$test = clone($renew_all_test_template); +#$test->{id} = 'Renew All: Valid patron, two items checked out'; +#$test->{pat} = qr/^66100020000$datepat/; +#foreach my $i (0 .. (scalar @{$test->{fields}})-1) { +# my $field = $test->{fields}[$i]; +# +# if ($field->{field} eq FID_RENEWED_ITEMS) { +# $field->{pat} = qr/^$item_barcode\|$item2_barcode$/; +# } +#} +# +#push @tests, $checkout_templates[0], $checkout_templates[1], +# $renew_all_test_template, $checkin_templates[0], $checkin_templates[1]; + +$test = clone($renew_all_test_template); +$test->{id} = 'Renew All: valid patron, invalid patron password'; +$test->{msg} .= (FID_PATRON_PWD) . 'badpwd|'; +$test->{pat} = qr/^66000000000$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + ]; + +push @tests, $checkout_templates[0], $test, $checkin_templates[0]; + +$test = clone($renew_all_test_template); +$test->{id} = 'Renew All: invalid patron'; +$test->{msg} =~ s/AA$user_barcode/AAberick/; +$test->{pat} = qr/^66000000000$datepat/; +delete $test->{fields}; +$test->{fields} = [ + $SIPtest::field_specs{(FID_INST_ID)}, + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + ]; +push @tests, $test; + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/11item_info.t b/C4/SIP/t/11item_info.t new file mode 100644 index 0000000000..a0d7ad2474 --- /dev/null +++ b/C4/SIP/t/11item_info.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl +# renew_all: test Renew All Response + +use strict; +use warnings; +use Clone qw(clone); + +use Sip::Constants qw(:all); + +use SIPtest qw($datepat $textpat $instid $currency $user_barcode + $item_barcode $item_title $item_owner); + +my $item_info_test_template = { + id => 'Item Information: check information for available item', + msg => "1720060110 215612AO$instid|AB$item_barcode|", + pat => qr/^180[13]0201$datepat/, # status of 'other' or 'available' + fields => [ + $SIPtest::field_specs{(FID_SCREEN_MSG)}, + $SIPtest::field_specs{(FID_PRINT_LINE)}, + { field => FID_ITEM_ID, + pat => qr/^$item_barcode$/, + required => 1, }, + { field => FID_TITLE_ID, + pat => qr/^$item_title\s*$/, + required => 1, }, + { field => FID_MEDIA_TYPE, + pat => qr/^\d{3}$/, + required => 0, }, + { field => FID_OWNER, + pat => qr/^$item_owner$/, + required => 0, }, + ], }; + +my @tests = ( + $SIPtest::login_test, + $SIPtest::sc_status_test, + clone($item_info_test_template), + ); + +SIPtest::run_sip_tests(@tests); + +1; diff --git a/C4/SIP/t/Makefile b/C4/SIP/t/Makefile new file mode 100644 index 0000000000..9f2e2480d1 --- /dev/null +++ b/C4/SIP/t/Makefile @@ -0,0 +1,16 @@ +# +# +# + +TESTS = 00sc_status.t 01patron_status.t 02patron_info.t 03checkout.t \ + 04patron_status.t 05block_patron.t 06patron_enable.t 07hold.t \ + 08checkin.t 09renew.t 10renew_all.t 11item_info.t + +OILS_TESTS = 00sc_status.t 01patron_status.t 02patron_info.t 03checkout.t \ + 08checkin.t 09renew.t 11item_info.t 05block_patron.t + +test-openils: + prove -I.. $(OILS_TESTS) + +test: + prove -I.. $(TESTS) diff --git a/C4/SIP/t/README b/C4/SIP/t/README new file mode 100644 index 0000000000..9f954f34ec --- /dev/null +++ b/C4/SIP/t/README @@ -0,0 +1,50 @@ +CONFIGURING THE TEST SUITE + +Before you can run the test suite, you need to configure certain +information about the SIP server and the ILS data in the file +SIPtest.pm. + +RUNNING THE TESTS + +Every file tests a different protocol transaction. +Unfortunately, a lot of test cases are missing, but the basics +are tested, as are most of the simple error conditions (invalid +users, unknown items, checking in item that's not checked out). + +To run a single test, just run + + perl -I.. + +If the test fails, the output should be pretty clear about what +went wrong (assuming you can read raw SIP packets). + +To run all the tests, just type + + make test + +Right now, that will run tests for functionality that isn't +supported in the Evergreen environment (the two main cases are +enable patron and hold management). To run just the Evergreen tests, use + + make test-openils + +which will run just the tests + + 00sc_status.t + 01patron_status.t + 02patron_info.t + 03checkout.t + 06patron_enable.t + 08checkin.t + 09renew.t + 11item_info.t + 05block_patron.t + +NOTE: the Block Patron tests are run last because "Patron Enable" +isn't supported. Thus, after running the "Block Patron" test, +manual intervention is required to unblock the test patron. + +The Renew All tests will fail when running the stub "ILS" +implementation unless there's only one ILS server running. This +won't be a problem for any real backend implementation that +properly manages the database of users and items. diff --git a/C4/SIP/t/SIPtest.pm b/C4/SIP/t/SIPtest.pm new file mode 100644 index 0000000000..dc3d51487d --- /dev/null +++ b/C4/SIP/t/SIPtest.pm @@ -0,0 +1,225 @@ +package SIPtest; + +use strict; +use warnings; + +use Exporter; + +our @ISA = qw(Exporter); + +our @EXPORT_OK = qw(run_sip_tests no_tagged_fields + $datepat $textpat + $login_test $sc_status_test + %field_specs + + $instid $currency $server $username $password + $user_barcode $user_pin $user_fullname $user_homeaddr + $user_email $user_phone $user_birthday $user_ptype + $user_inet + $item_barcode $item_title $item_owner + $item2_barcode $item2_title $item2_owner + $item_diacritic_barcode $item_diacritic_title + $item_diacritic_owner); +#use Data::Dumper; + +# The number of tests is set in run_sip_tests() below, based +# on the size of the array of tests. +use Test::More; + +use IO::Socket::INET; +use Sip qw(:all); +use Sip::Checksum qw(verify_cksum); +use Sip::Constants qw(:all); + +# +# Configuration parameters to run the test suite +# +our $instid = 'UWOLS'; +our $currency = 'CAD'; +our $server = 'localhost:6001'; # Address of the SIP server + +# SIP username and password to connect to the server. See the +# SIP config.xml for the correct values. +our $username = 'scclient'; +our $password = 'clientpwd'; + +# ILS Information + +# Valid user barcode and corresponding user password/pin and full name +our $user_barcode = 'djfiander'; +our $user_pin = '6789'; +our $user_fullname= 'David J\. Fiander'; +our $user_homeaddr= '2 Meadowvale Dr\. St Thomas, ON'; +our $user_email = 'djfiander\@hotmail\.com'; +our $user_phone = '\(519\) 555 1234'; +our $user_birthday= '19640925'; +our $user_ptype = 'A'; +our $user_inet = 'Y'; + +# Valid item barcode and corresponding title +our $item_barcode = '1565921879'; +our $item_title = 'Perl 5 desktop reference'; +our $item_owner = 'UWOLS'; + +# Another valid item +our $item2_barcode = '0440242746'; +our $item2_title = 'The deep blue alibi'; +our $item2_owner = 'UWOLS'; + +# An item with a diacritical in the title +our $item_diacritic_barcode = '660'; +our $item_diacritic_title = 'Harry Potter y el cáliz de fuego'; +our $item_diacritic_owner = 'UWOLS'; + +# End configuration + +# Pattern for a SIP datestamp, to be used by individual tests to +# match timestamp fields (duh). +our $datepat = '\d{8} {4}\d{6}'; + +# Pattern for a random text field (may be empty) +our $textpat = qr/^[^|]*$/; + +our %field_specs = ( + (FID_SCREEN_MSG) => { field => FID_SCREEN_MSG, + pat => $textpat, + required => 0, }, + (FID_PRINT_LINE) => { field => FID_PRINT_LINE, + pat => $textpat, + required => 0, }, + (FID_INST_ID) => { field => FID_INST_ID, + pat => qr/^$instid$/o, + required => 1, }, + (FID_HOLD_ITEMS_LMT)=> { field => FID_HOLD_ITEMS_LMT, + pat => qr/^\d{4}$/, + required => 0, }, + (FID_OVERDUE_ITEMS_LMT)=> { field => FID_OVERDUE_ITEMS_LMT, + pat => qr/^\d{4}$/, + required => 0, }, + (FID_CHARGED_ITEMS_LMT)=> { field => FID_CHARGED_ITEMS_LMT, + pat => qr/^\d{4}$/, + required => 0, }, + (FID_VALID_PATRON) => { field => FID_VALID_PATRON, + pat => qr/^[NY]$/, + required => 0, }, + (FID_VALID_PATRON_PWD)=> { field => FID_VALID_PATRON_PWD, + pat => qr/^[NY]$/, + required => 0, }, + (FID_CURRENCY) => { field => FID_CURRENCY, + pat => qr/^$currency$/io, + required => 0, }, + ); + +# Login and SC Status are always the first two messages that +# the terminal sends to the server, so just create the test +# cases here and reference them in the individual test files. + +our $login_test = { id => 'login', + msg => "9300CN$username|CO$password|CPThe floor|", + pat => qr/^941/, + fields => [], }; + +our $sc_status_test = { id => 'SC status', + msg => '9910302.00', + pat => qr/^98[YN]{6}\d{3}\d{3}$datepat(2\.00|1\.00)/, + fields => [ + $field_specs{(FID_SCREEN_MSG)}, + $field_specs{(FID_PRINT_LINE)}, + $field_specs{(FID_INST_ID)}, + { field => 'AM', + pat => $textpat, + required => 0, }, + { field => 'BX', + pat => qr/^[YN]{16}$/, + required => 1, }, + { field => 'AN', + pat => $textpat, + required => 0, }, + ], + }; + +sub one_msg { + my ($sock, $test, $seqno) = @_; + my $resp; + my %fields; + + # If reading or writing fails, then the server's dead, + # so there's no point in continuing. + if (!write_msg({seqno => $seqno}, $test->{msg}, $sock)) { + BAIL_OUT("Write failure in $test->{id}"); + } elsif (!($resp = <$sock>)) { + BAIL_OUT("Read failure in $test->{id}"); + } + + chomp($resp); + + if (!verify_cksum($resp)) { + fail("checksum $test->{id}"); + return; + } + if ($resp !~ $test->{pat}) { + fail("match leader $test->{id}"); + diag("Response '$resp' doesn't match pattern '$test->{pat}'"); + return; + } + + # Split the tagged fields of the response into (name, value) + # pairs and stuff them into the hash. + $resp =~ $test->{pat}; + %fields = substr($resp, $+[0]) =~ /(..)([^|]*)\|/go; + +# print STDERR Dumper($test); +# print STDERR Dumper(\%fields); + if (!defined($test->{fields})) { + diag("TODO: $test->{id} field tests not written yet"); + } else { + # If there are no tagged fields, then 'fields' should be an + # empty list which will automatically skip this loop + foreach my $ftest (@{$test->{fields}}) { + my $field = $ftest->{field}; + + if ($ftest->{required} && !exists($fields{$field})) { + fail("$test->{id} required field '$field' exists in '$resp'"); + return; + } + + if (exists($fields{$field}) && ($fields{$field} !~ $ftest->{pat})) { + + fail("$test->{id} field test $field"); + diag("Field pattern '$ftest->{pat}' for '$field' doesn't match in '$resp'"); + return; + } + } + } + pass("$test->{id}"); + return; +} + +# +# _count_tests: Count the number of tests in a test array +sub _count_tests { + return scalar @_; +} + +sub run_sip_tests { + my ($sock, $seqno); + + $Sip::error_detection = 1; + $/ = "\r"; + + $sock = new IO::Socket::INET(PeerAddr => $server, + Type => SOCK_STREAM); + + BAIL_OUT('failed to create connection to server') unless $sock; + + $seqno = 1; + + plan tests => _count_tests(@_); + + foreach my $test (@_) { + one_msg($sock, $test, $seqno++); + $seqno %= 10; # sequence number is one digit + } +} + +1; diff --git a/C4/SIP/test.txt b/C4/SIP/test.txt new file mode 100644 index 0000000000..775b14793e --- /dev/null +++ b/C4/SIP/test.txt @@ -0,0 +1,17 @@ +97AZFEF5 +2300120060101 084235AOUWOLS|AAdjfiander|ACterminal password|ADuser password| +2300120060101 084236AOUWOLS|AAmjandkilde|ACterminal password|ADuser password| +2300120060101 084237AOUWOLS|AAdjfiander|ACterminal password|ADuser password| +9300CNLoginUserID|COLoginPassword|CPLocationCode| +11YN20060329 203000 AOUWOLS|AAdjfiander|AB1565921879|AC| +09Y20060102 08423620060113 084235APUnder the bed|AOUWOLS|AB1565921879|ACterminal password| +01N20060102 084238AOUWOLS|ALHe's a jerk|AAdjfiander|ACterminal password| +2520060102 084238AOUWOLS|AAdjfiander|ACterminal password|AD6789| +9910302.00 +3520060110 084237AOUWOLS|AAdjfiander|AD6789| +1720060110 215612AOUWOLS|AB1565921879| +6300020060329 201700Y AOUWOLS|AAdjfiander| +15+20060415 110158BW20060815 110158|BSTaylor|BY2|AOUWOLS|AAdjfiander|AB1565921879| +15-20060415 110158AOUWOLS|AAdjfiander|AB1565921879| +29NN20060415 110158 AOUWOLS|AAdjfiander|AD6789|AB1565921879| +6520060415 110158AOUWOLS|AAdjfiander|AD6789| diff --git a/C4/SIP/xmlparse.pl b/C4/SIP/xmlparse.pl new file mode 100644 index 0000000000..faa5dc7966 --- /dev/null +++ b/C4/SIP/xmlparse.pl @@ -0,0 +1,29 @@ +# +# This file reads a SIPServer xml-format configuration file and dumps it +# to stdout. Just to see what the structures look like. +# +# The 'new XML::Simple' option must agree exactly with the configuration +# in Sip::Configuration.pm +# +use strict; +use English; + +use XML::Simple qw(:strict); +use Data::Dumper; + +my $parser = new XML::Simple( KeyAttr => { login => '+id', + institution => '+id', + service => '+port', }, + GroupTags => { listeners => 'service', + accounts => 'login', + institutions => 'institution', }, + ForceArray=> [ 'service', + 'login', + 'institution' ], + ValueAttr => { 'error-detect' => 'enabled', + 'min_servers' => 'value', + 'max_servers' => 'value'} ); + +my $ref = $parser->XMLin($ARGV[0]); + +print Dumper($ref); diff --git a/C4/SIP_openils_pm b/C4/SIP_openils_pm new file mode 100644 index 0000000000..b8aff71bff --- /dev/null +++ b/C4/SIP_openils_pm @@ -0,0 +1,617 @@ +# +# ILS.pm: Test ILS interface module +# + +package OpenILS::SIP; +use warnings; use strict; + +use Sys::Syslog qw(syslog); + +use OpenILS::SIP::Item; +use OpenILS::SIP::Patron; +use OpenILS::SIP::Transaction; +use OpenILS::SIP::Transaction::Checkout; +use OpenILS::SIP::Transaction::Checkin; +use OpenILS::SIP::Transaction::Renew; + +use OpenSRF::System; +use OpenILS::Utils::Fieldmapper; +use OpenSRF::Utils::SettingsClient; +use OpenILS::Application::AppUtils; +use OpenSRF::Utils qw/:datetime/; +use DateTime::Format::ISO8601; +my $U = 'OpenILS::Application::AppUtils'; + +my $editor; +my $config; + +use Digest::MD5 qw(md5_hex); + +sub new { + my ($class, $institution, $login) = @_; + my $type = ref($class) || $class; + my $self = {}; + + $self->{login} = $login; + + $config = $institution; + syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id}); + $self->{institution} = $institution; + + my $bsconfig = $institution->{implementation_config}->{bootstrap}; + + syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig"); + + local $/ = "\n"; + OpenSRF::System->bootstrap_client(config_file => $bsconfig); + syslog('LOG_DEBUG', "OILS: bootstrap loaded.."); + + $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new; + + Fieldmapper->import($self->{osrf_config}->config_value('IDL')); + + bless( $self, $type ); + + return undef unless + $self->login( $login->{id}, $login->{password} ); + + return $self; +} + +sub verify_session { + my $self = shift; + my $ses = $U->simplereq( + 'open-ils.auth', + 'open-ils.auth.session.retrieve', $self->{authtoken} ); + return 1 unless $U->event_code($ses); + syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id}); + return $self->login( $self->{login}->{id}, $self->{login}->{password} ); +} + +sub to_bool { + my $val = shift; + return ($val and $val =~ /true/io); +} + +sub editor { + return $editor + if $editor and $editor->{session} + and $editor->session->connected; + return $editor = make_editor(); +} + +sub reset_editor { + $editor = undef; + return editor(); +} + +sub config { + return $config; +} + + +# Creates the global editor object +sub make_editor { + require OpenILS::Utils::CStoreEditor; + my $e = OpenILS::Utils::CStoreEditor->new(xact => 1); + # gnarly cstore hack to re-gen autogen methods after IDL is loaded + if(!UNIVERSAL::can($e, 'search_actor_card')) { + syslog("LOG_WARNING", "OILS: Reloading CStoreEditor..."); + delete $INC{'OpenILS/Utils/CStoreEditor.pm'}; + require OpenILS::Utils::CStoreEditor; + $e = OpenILS::Utils::CStoreEditor->new(xact =>1); + } + return $e; +} + +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::clense_ISO8601($date)); + my @time = localtime($date->epoch); + + my $year = $time[5]+1900; + my $mon = $time[4]+1; + my $day = $time[3]; + + $mon =~ s/^(\d)$/0$1/; + $day =~ s/^(\d)$/0$1/; + $date = "$year$mon$day"; + + $date = $year.'-'.$mon.'-'.$day .' 00:00:00' if $type eq 'due'; + #$date = $year.'-'.$mon.'-'.$day if $type eq 'due'; + + 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"); + return $self->{authtoken} = $key; +} + + +sub find_patron { + my $self = shift; + return OpenILS::SIP::Patron->new(@_); +} + + +sub find_item { + my $self = shift; + return OpenILS::SIP::Item->new(@_); +} + + +sub institution { + my $self = shift; + return $self->{institution}->{id}; +} + +sub supports { + my ($self, $op) = @_; + my ($i) = grep { $_->{name} eq $op } + @{$config->{implementation_config}->{supports}->{item}}; + return to_bool($i->{value}); +} + +sub check_inst_id { + my ($self, $id, $whence) = @_; + if ($id ne $self->{institution}->{id}) { + syslog("LOG_WARNING", + "OILS: %s: received institution '%s', expected '%s'", + $whence, $id, $self->{institution}->{id}); + } +} + +sub checkout_ok { + return to_bool($config->{policy}->{checkout}); +} + +sub checkin_ok { + return to_bool($config->{policy}->{checkin}); + return 0; +} + +sub renew_ok { + return to_bool($config->{policy}->{renew}); +} + +sub status_update_ok { + return to_bool($config->{policy}->{status_update}); +} + +sub offline_ok { + return to_bool($config->{policy}->{offline}); +} + + + +## +## Checkout(patron_id, item_id, sc_renew): +## patron_id & item_id are the identifiers send by the terminal +## sc_renew is the renewal policy configured on the terminal +## returns a status opject that can be queried for the various bits +## of information that the protocol (SIP or NCIP) needs to generate +## the response. +## + +sub checkout { + my ($self, $patron_id, $item_id, $sc_renew) = @_; + + $self->verify_session; + + 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"); + return $xact; + } + + if (!$patron->charge_ok) { + $xact->screen_msg("Patron Blocked"); + return $xact; + } + + if( !$item ) { + $xact->screen_msg("Invalid Item"); + return $xact; + } + + syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out..."); + $xact->do_checkout(); + + if ($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); + } + + $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); + } + + return $xact; +} + + +sub checkin { + my ($self, $item_id, $trans_date, $return_date, + $current_loc, $item_props, $cancel) = @_; + + $self->verify_session; + + syslog('LOG_DEBUG', "OILS: OpenILS::Checkin on item=$item_id"); + + my $patron; + my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken}); + my $item = $self->find_item($item_id); + + $xact->item($item); + + if(!$xact->item) { + $xact->screen_msg("Invalid item barcode: $item_id"); + $xact->ok(0); + return $xact; + } + + $xact->do_checkin( $trans_date, $return_date, $current_loc, $item_props ); + + if ($xact->ok) { + + $xact->patron($patron = $self->find_patron($item->{patron})); + delete $item->{patron}; + delete $item->{due_date}; + syslog('LOG_INFO', "OILS: Checkin succeeded"); + #editor()->commit; + + } else { + + #editor()->xact_rollback; + syslog('LOG_WARNING', "OILS: Checkin failed"); + } + # END TRANSACTION + + return $xact; +} + +## If the ILS caches patron information, this lets it free it up +sub end_patron_session { + my ($self, $patron_id) = @_; + return (1, 'Thank you for using OpenILS!', ''); +} + + +#sub pay_fee { +# my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type, +# $pay_type, $fee_id, $trans_id, $currency) = @_; +# my $trans; +# my $patron; +# +# $trans = new ILS::Transaction::FeePayment; +# +# $patron = new ILS::Patron $patron_id; +# +# $trans->transaction_id($trans_id); +# $trans->patron($patron); +# $trans->ok(1); +# +# return $trans; +#} +# +#sub add_hold { +# my ($self, $patron_id, $patron_pwd, $item_id, $title_id, +# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_; +# my ($patron, $item); +# my $hold; +# my $trans; +# +# +# $trans = new ILS::Transaction::Hold; +# +# # BEGIN TRANSACTION +# $patron = new ILS::Patron $patron_id; +# if (!$patron +# || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) { +# $trans->screen_msg("Invalid Patron."); +# +# return $trans; +# } +# +# $item = new ILS::Item ($item_id || $title_id); +# if (!$item) { +# $trans->screen_msg("No such item."); +# +# # END TRANSACTION (conditionally) +# return $trans; +# } elsif ($item->fee && ($fee_ack ne 'Y')) { +# $trans->screen_msg = "Fee required to place hold."; +# +# # 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, +# }; +# +# $trans->ok(1); +# $trans->patron($patron); +# $trans->item($item); +# $trans->pickup_location($pickup_location); +# +# push(@{$item->hold_queue}, $hold); +# push(@{$patron->{hold_items}}, $hold); +# +# +# # END TRANSACTION +# return $trans; +#} +# +#sub cancel_hold { +# my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_; +# my ($patron, $item, $hold); +# my $trans; +# +# $trans = new ILS::Transaction::Hold; +# +# # BEGIN TRANSACTION +# $patron = new ILS::Patron $patron_id; +# if (!$patron) { +# $trans->screen_msg("Invalid patron barcode."); +# +# return $trans; +# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { +# $trans->screen_msg('Invalid patron password.'); +# +# return $trans; +# } +# +# $item = new ILS::Item ($item_id || $title_id); +# if (!$item) { +# $trans->screen_msg("No such item."); +# +# # 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."); +# +# # 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]; +# +# if ($hold->{patron_id} eq $patron->id) { +# # found it: delete it. +# splice @{$item->hold_queue}, $i, 1; +# last; +# } +# } +# +# $trans->screen_msg("Hold Cancelled."); +# $trans->patron($patron); +# $trans->item($item); +# +# return $trans; +#} +# +# +## The patron and item id's can't be altered, but the +## 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) = @_; +# my ($patron, $item); +# my $hold; +# my $trans; +# +# $trans = new ILS::Transaction::Hold; +# +# # BEGIN TRANSACTION +# $patron = new ILS::Patron $patron_id; +# if (!$patron) { +# $trans->screen_msg("Invalid patron barcode."); +# +# 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; +# } +# } +# +# # The same hold structure is linked into both the patron's +# # list of hold items and into the queue of outstanding holds +# # for the item, so we don't need to search the hold queue for +# # the item, since it's already been updated by the patron code. +# +# if (!$trans->ok) { +# $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("Item Id renewal not supported."); + } 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; +} + + + + + +# +#sub renew_all { +# my ($self, $patron_id, $patron_pwd, $fee_ack) = @_; +# my ($patron, $item_id); +# my $trans; +# +# $trans = new ILS::Transaction::RenewAll; +# +# $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); +# } else { +# syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", +# $patron_id); +# } +# +# if (!defined($patron)) { +# $trans->screen_msg("Invalid patron barcode."); +# return $trans; +# } elsif (!$patron->renew_ok) { +# $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; +# } +# +# 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; +# } +# } +# +# $trans->ok(1); +# +# return $trans; +#} + +1;