[Koha-patches] [PATCH 1/2] 3M SIP2 Extensions groundwork and Patron Info popoulation
Galen Charlton
galen.charlton at liblime.com
Wed Jul 22 16:08:38 CEST 2009
From: Joe Atzberger <joe.atzberger at liblime.com>
This includes some initial work for the 3M SIP2 extensions.
It also better populates the Patron object with methods for
a fuller Patron Information Reponse. This is positively affect
EnvisionWare software, as used by NEKLS.
Signed-off-by: Galen Charlton <galen.charlton at liblime.com>
---
C4/SIP/ILS.pm | 47 +++---
C4/SIP/ILS/Patron.pm | 297 +++++++++++++++----------------
C4/SIP/ILS/Transaction/Checkin.pm | 64 +++++--
C4/SIP/SIPServer.pm | 26 ++-
C4/SIP/Sip/Configuration/Institution.pm | 24 +++-
C4/SIP/Sip/Constants.pm | 262 ++++++++++------------------
C4/SIP/Sip/MsgType.pm | 253 ++++++++++----------------
C4/SIP/t/SIPtest.pm | 4 +-
8 files changed, 450 insertions(+), 527 deletions(-)
diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm
index 4315540..09c454f 100644
--- a/C4/SIP/ILS.pm
+++ b/C4/SIP/ILS.pm
@@ -21,25 +21,25 @@ use ILS::Transaction::RenewAll;
my $debug = 0;
my %supports = (
- 'magnetic media' => 1,
- '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" => 1,
- );
+ 'magnetic media' => 1,
+ '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" => 1,
+);
sub new {
my ($class, $institution) = @_;
@@ -66,6 +66,11 @@ sub find_item {
sub institution {
my $self = shift;
+ return $self->{institution}->{id}; # consider making this return the whole institution
+}
+
+sub institution_id {
+ my $self = shift;
return $self->{institution}->{id};
}
@@ -174,8 +179,8 @@ sub checkin {
$circ = new ILS::Transaction::Checkin;
# BEGIN TRANSACTION
$circ->item($item = new ILS::Item $item_id);
-
- $circ->do_checkin();
+
+ $circ->do_checkin($current_loc, $return_date);
# It's ok to check it in if it exists, and if it was checked out
$circ->ok($item && $item->{patron});
diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm
index 682248e..abdb7e9 100644
--- a/C4/SIP/ILS/Patron.pm
+++ b/C4/SIP/ILS/Patron.pm
@@ -10,22 +10,24 @@ package ILS::Patron;
use strict;
use warnings;
use Exporter;
+use Carp;
use Sys::Syslog qw(syslog);
use Data::Dumper;
use C4::Debug;
use C4::Context;
-use C4::Dates;
+# use C4::Dates;
use C4::Koha;
use C4::Members;
use C4::Reserves;
+use C4::Branch qw(GetBranchName);
use Digest::MD5 qw(md5_base64);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
BEGIN {
- $VERSION = 2.02;
+ $VERSION = 2.03;
@ISA = qw(Exporter);
@EXPORT_OK = qw(invalid_patron);
}
@@ -44,63 +46,67 @@ sub new {
}
$kp = GetMemberDetails(undef,$patron_id);
$debug and warn "new Patron (GetMemberDetails): " . Dumper($kp);
- my $pw = $kp->{password}; ## FIXME - md5hash -- deal with .
- my $dob= $kp->{dateofbirth};
- my $fines_out = GetMemberAccountRecords($kp->{borrowernumber});
- my $flags = $kp->{flags}; # or warn "Warning: No flags from patron object for '$patron_id'";
- my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues});
- $debug and warn sprintf("Debarred = %s : ",($debarred||'undef')) . Dumper(%{$kp->{flags}});
+ my $pw = $kp->{password}; ### FIXME - md5hash -- deal with .
+ my $flags = $kp->{flags}; # or warn "Warning: No flags from patron object for '$patron_id'";
+ my $debarred = $kp->{debarred}; # 1 if ($kp->{flags}->{DBARRED}->{noissues});
+ $debug and warn sprintf("Debarred = %s : ", ($debarred||'undef')) . Dumper(%{$kp->{flags}});
my %ilspatron;
my $adr = $kp->{streetnumber} || '';
my $address = $kp->{address} || '';
+ my $dob = $kp->{dateofbirth};
+ $dob and $dob =~ s/-//g; # YYYYMMDD
$adr .= ($adr && $address) ? " $address" : $address;
- {
+ my $fines_amount = $flags->{CHARGES}->{amount};
+ $fines_amount = ($fines_amount and $fines_amount > 0) ? $fines_amount : 0;
+ {
no warnings; # any of these $kp->{fields} being concat'd could be undef
- $dob =~ s/\-//g;
- %ilspatron = (
- getmemberdetails_object => $kp,
- name => $kp->{firstname} . " " . $kp->{surname},
- id => $kp->{cardnumber}, # to SIP, the id is the BARCODE, not userid
- password => $pw,
- ptype => $kp->{categorycode}, # 'A'dult. Whatever.
- birthdate => $kp->{dateofbirth}, ##$dob,
- branchcode => $kp->{branchcode},
- borrowernumber => $kp->{borrowernumber},
- address => $adr,
- home_phone => $kp->{phone},
- email_addr => $kp->{email},
- charge_ok => (!$debarred), ## (C4::Context->preference('FinesMode') eq 'charge') || 0,
- renew_ok => (!$debarred),
- recall_ok => (!$debarred),
- hold_ok => (!$debarred),
- card_lost => ($kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST}) ,
- claims_returned => 0,
- fines => $fines_out,
- fees => 0, # currently not distinct from fines
- recall_overdue => 0,
- items_billed => 0,
- screen_msg => 'Greetings from Koha. ' . $kp->{opacnote},
- print_line => '',
- items => [],
- hold_items => $flags->{WAITING}{itemlist},
- overdue_items => $flags->{ODUES}{itemlist},
- fine_items => [],
- recall_items => [],
- unavail_holds => [],
- inet => 1,
- );
- }
+ %ilspatron = (
+ getmemberdetails_object => $kp,
+ name => $kp->{firstname} . " " . $kp->{surname},
+ id => $kp->{cardnumber}, # to SIP, the id is the BARCODE, not userid
+ password => $pw,
+ ptype => $kp->{categorycode}, # 'A'dult. Whatever.
+ birthdate => $dob,
+ birthdate_iso => $kp->{dateofbirth},
+ branchcode => $kp->{branchcode},
+ library_name => "", # only populated if needed, cached here
+ borrowernumber => $kp->{borrowernumber},
+ address => $adr,
+ home_phone => $kp->{phone},
+ email_addr => $kp->{email},
+ charge_ok => ( !$debarred ),
+ renew_ok => ( !$debarred ),
+ recall_ok => ( !$debarred ),
+ hold_ok => ( !$debarred ),
+ card_lost => ( $kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST} ),
+ claims_returned => 0,
+ fines => $fines_amount, # GetMemberAccountRecords($kp->{borrowernumber})
+ fees => 0, # currently not distinct from fines
+ recall_overdue => 0,
+ items_billed => 0,
+ screen_msg => 'Greetings from Koha. ' . $kp->{opacnote},
+ print_line => '',
+ items => [],
+ hold_items => $flags->{WAITING}{itemlist},
+ overdue_items => $flags->{ODUES}{itemlist},
+ fine_items => [],
+ recall_items => [],
+ unavail_holds => [],
+ inet => ( !$debarred ),
+ );
+ }
+ print STDERR "patron fines: $ilspatron{fines} ... amountoutstanding: $kp->{amountoutstanding} ... CHARGES->amount: $flags->{CHARGES}->{amount}\n";
for (qw(CHARGES CREDITS GNA LOST DBARRED NOTES)) {
($flags->{$_}) or next;
$ilspatron{screen_msg} .= ($flags->{$_}->{message} || '') ;
- if ($flags->{$_}->{noissues}){
- foreach my $toggle (qw(charge_ok renew_ok recall_ok hold_ok)) {
- $ilspatron{$toggle} = 0;
+ if ($flags->{$_}->{noissues}) {
+ foreach my $toggle (qw(charge_ok renew_ok recall_ok hold_ok inet)) {
+ $ilspatron{$toggle} = 0; # if we get noissues, disable everything
}
}
}
- # FIXME: populate fine_items recall_items
+ # FIXME: populate fine_items recall_items
# $ilspatron{hold_items} = (GetReservesFromBorrowernumber($kp->{borrowernumber},'F'));
$ilspatron{unavail_holds} = [(GetReservesFromBorrowernumber($kp->{borrowernumber}))];
$ilspatron{items} = GetPendingIssues($kp->{borrowernumber});
@@ -111,62 +117,67 @@ sub new {
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};
+
+# 0 means read-only
+# 1 means read/write
+
+my %fields = (
+ id => 0,
+ name => 0,
+ address => 0,
+ email_addr => 0,
+ home_phone => 0,
+ birthdate => 0,
+ birthdate_iso => 0,
+ ptype => 0,
+ charge_ok => 0, # for patron_status[0] (inverted)
+ renew_ok => 0, # for patron_status[1] (inverted)
+ recall_ok => 0, # for patron_status[2] (inverted)
+ hold_ok => 0, # for patron_status[3] (inverted)
+ card_lost => 0, # for patron_status[4]
+ recall_overdue => 0,
+ currency => 1,
+# fee_limit => 0,
+ screen_msg => 1,
+ print_line => 1,
+ too_many_charged => 0, # for patron_status[5]
+ too_many_overdue => 0, # for patron_status[6]
+ too_many_renewal => 0, # for patron_status[7]
+ too_many_claim_return => 0, # for patron_status[8]
+ too_many_lost => 0, # for patron_status[9]
+# excessive_fines => 0, # for patron_status[10]
+# excessive_fees => 0, # for patron_status[11]
+ recall_overdue => 0, # for patron_status[12]
+ too_many_billed => 0, # for patron_status[13]
+ inet => 0, # EnvisionWare extension
+ getmemberdetails_object => 0,
+);
+
+our $AUTOLOAD;
+
+sub DESTROY {
+ # be cool. needed for AUTOLOAD(?)
}
-sub recall_overdue {
+
+sub AUTOLOAD {
my $self = shift;
- return $self->{recall_overdue};
+ my $class = ref($self) or croak "$self is not an object";
+ my $name = $AUTOLOAD;
+
+ $name =~ s/.*://;
+
+ unless (exists $fields{$name}) {
+ croak "Cannot access '$name' field of class '$class'";
+ }
+
+ if (@_) {
+ $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY.";
+ return $self->{$name} = shift;
+ } else {
+ return $self->{$name};
+ }
}
+
sub check_password {
my ($self, $pwd) = @_;
my $md5pwd = $self->{password};
@@ -175,57 +186,21 @@ sub check_password {
(defined $md5pwd) or return($pwd eq ''); # if the record has a NULL password, accept '' as match
return (md5_base64($pwd) eq $md5pwd);
}
-sub currency {
- my $self = shift;
- return $self->{currency};
-}
+
+# A few special cases, not in AUTOLOADed %fields
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};
+ return $self->{fines} || undef;
}
-sub excessive_fines {
- my $self = shift;
- return $self->{excessive_fines};
-}
-sub excessive_fees {
- my $self = shift;
- return $self->{excessive_fees};
-}
-sub too_many_billed {
+
+sub fines_amount {
my $self = shift;
- return $self->{too_many_billed};
+ return $self->fee_amount;
}
-sub getmemberdetails_object {
+
+sub language {
my $self = shift;
- return $self->{getmemberdetails_object};
+ return $self->{language} || '000'; # Unspecified
}
#
@@ -236,7 +211,7 @@ sub hold_items {
$self->{hold_items} or return [];
$start = 1 unless defined($start);
$end = scalar @{$self->{hold_items}} unless defined($end);
- return [@{$self->{hold_items}}[$start-1 .. $end-1]];
+ return [@{$self->{hold_items}}[$start-1 .. $end-1]]; # SIP "start item" and "end item" values are 1-indexed, not 0 like perl arrays
}
#
@@ -304,22 +279,23 @@ sub unavail_holds {
sub block {
my ($self, $card_retained, $blocked_card_msg) = @_;
- foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
+ foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
$self->{$field} = 0;
}
- $self->{screen_msg} = $blocked_card_msg || "Card Blocked. Please contact library staff";
+ $self->{screen_msg} = "Feature not implemented"; # $blocked_card_msg || "Card Blocked. Please contact library staff";
+ # TODO: not really affecting patron record
return $self;
}
sub enable {
my $self = shift;
- foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') {
+ foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') {
$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."; # FIXME: not really affecting patron record
+ $self->{screen_msg} = "This feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record
return $self;
}
@@ -328,6 +304,27 @@ sub inet_privileges {
return $self->{inet} ? 'Y' : 'N';
}
+sub fee_limit {
+ # my $self = shift;
+ return C4::Context->preference("noissuescharge") || 5;
+}
+
+sub excessive_fees {
+ my $self = shift or return;
+ return ($self->fee_amount and $self->fee_amount > $self->fee_limit);
+}
+sub excessive_fines {
+ my $self = shift or return;
+ return $self->excessive_fees; # same thing for Koha
+}
+
+sub library_name {
+ my $self = shift;
+ unless ($self->{library_name}) {
+ $self->{library_name} = GetBranchName($self->{branchcode});
+ }
+ return $self->{library_name};
+}
#
# Messages
#
diff --git a/C4/SIP/ILS/Transaction/Checkin.pm b/C4/SIP/ILS/Transaction/Checkin.pm
index bcf5c78..6c4f360 100644
--- a/C4/SIP/ILS/Transaction/Checkin.pm
+++ b/C4/SIP/ILS/Transaction/Checkin.pm
@@ -17,40 +17,68 @@ use C4::Circulation;
our @ISA = qw(ILS::Transaction);
my %fields = (
- magnetic => 0,
- sort_bin => undef,
+ magnetic => 0,
+ sort_bin => undef,
+ collection_code => undef,
+ # 3M extensions:
+ call_number => undef,
+ destination_loc => undef,
+ alert_type => undef, # 00,01,02,03,04 or 99
+ hold_patron_id => undef,
+ hold_patron_name => "",
+ hold => undef,
);
sub new {
- my $class = shift;;
- my $self = $class->SUPER::new();
- my $element;
+ my $class = shift;
+ my $self = $class->SUPER::new();
- foreach $element (keys %fields) {
- $self->{_permitted}->{$element} = $fields{$element};
- }
+ foreach (keys %fields) {
+ $self->{_permitted}->{$_} = $fields{$_}; # overlaying _permitted
+ }
- @{$self}{keys %fields} = values %fields;
- return bless $self, $class;
+ @{$self}{keys %fields} = values %fields; # copying defaults into object
+ return bless $self, $class;
}
sub do_checkin {
- my $self = shift;
- my $barcode = $self->{item}->{id};
- my $branch='ALB'; # gotta set this
- # FIXME: hardcoded branch not good.
- my $return = AddReturn($barcode,$branch);
- $self->ok($return);
- return 1;
+ my $self = shift;
+ my $branch = @_ ? shift : 'SIP2' ;
+ my $barcode = $self->{item}->id;
+ my ($return, $messages, $iteminformation, $borrower) = AddReturn($barcode, $branch);
+ $self->alert(!$return);
+ if ($messages->{BadBarcode}) {
+ $self->alert_type('99');
+ }
+ # ignoring: NotIssued, IsPermanent
+ if ($messages->{wthdrawn}) {
+ $self->alert_type('99');
+ }
+ if ($messages->{ResFound}) {
+ if ($self->hold($messages->{ResFound}->{ResFound})) {
+ $self->alert_type('99');
+ }
+ }
+ defined $self->alert_type and $self->alert(1); # alert_type could be "00"
+ $self->ok($return);
}
sub resensitize {
my $self = shift;
unless ($self->{item}) {
warn "no item found in object to resensitize";
- return undef;
+ return;
}
return !$self->{item}->magnetic;
}
+sub patron_id {
+ my $self = shift;
+ unless ($self->{patron}) {
+ warn "no patron found in object";
+ return;
+ }
+ return !$self->{patron}->id;
+}
+
1;
diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm
index b872e77..55b2380 100644
--- a/C4/SIP/SIPServer.pm
+++ b/C4/SIP/SIPServer.pm
@@ -21,7 +21,7 @@ use constant LOG_SIP => "local6"; # Local alias for the logging facility
use vars qw(@ISA $VERSION);
BEGIN {
- $VERSION = 1.01;
+ $VERSION = 1.02;
@ISA = qw(Net::Server::PreFork);
}
@@ -55,8 +55,20 @@ foreach my $svc (keys %{$config->{listeners}}) {
#
# Logging
#
-push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
- "syslog_facility=" . LOG_SIP;
+# Log lines look like this:
+# Jun 16 21:21:31 server08 steve_sip[19305]: ILS::Transaction::Checkout performing checkout...
+# [ TIMESTAMP ] [ HOST ] [ IDENT ] PID : Message...
+#
+# The IDENT is determined by $ENV{KOHA_SIP_LOG_IDENT}, if present.
+# Otherwise it is "_sip" appended to $USER, if present, or "acs-server" as a fallback.
+#
+
+my $syslog_ident = $ENV{KOHA_SIP_LOG_IDENT} || ($ENV{USER} ? $ENV{USER} . "_sip" : 'acs-server');
+
+push @parms,
+ "log_file=Sys::Syslog",
+ "syslog_ident=$syslog_ident",
+ "syslog_facility=" . LOG_SIP;
#
# Server Management: set parameters for the Net::Server::PreFork
@@ -70,6 +82,7 @@ if (defined($config->{'server-params'})) {
}
}
+print scalar(localtime), " -- startup -- procid:$$\n";
print "Params for Net::Server::PreFork : \n" . Dumper(\@parms);
#
@@ -211,13 +224,6 @@ sub telnet_transport {
$uid = get_clean_string ($uid);
$pwd = get_clean_string ($pwd);
syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
- # $uid =~ s/^\s+//; #
- # $pwd =~ s/^\s+//; #
- # $uid =~ s/[\r\n]+$//gms; #
- # $pwd =~ s/[\r\n]+$//gms; #
- # $uid =~ s/[[:cntrl:]]//g; #
- # $pwd =~ s/[[:cntrl:]]//g; #
- # syslog("LOG_DEBUG", "telnet_transport 3: uid length %s, pwd length %s", length($uid), length($pwd));
if (exists ($config->{accounts}->{$uid})
&& ($pwd eq $config->{accounts}->{$uid}->password())) {
diff --git a/C4/SIP/Sip/Configuration/Institution.pm b/C4/SIP/Sip/Configuration/Institution.pm
index cdd8a08..1e50af2 100644
--- a/C4/SIP/Sip/Configuration/Institution.pm
+++ b/C4/SIP/Sip/Configuration/Institution.pm
@@ -15,8 +15,8 @@ sub new {
my $type = ref($class) || $class;
if (ref($obj) eq "HASH") {
- # Just bless the object
- return bless $obj, $type;
+ # Just bless the object
+ return bless $obj, $type;
}
return bless {}, $type;
@@ -27,11 +27,31 @@ sub name {
return $self->{name};
}
+sub id {
+ my $self = shift;
+ return $self->{id};
+}
+
+sub implementation {
+ my $self = shift;
+ return $self->{implementation};
+}
+
sub policy {
my $self = shift;
return $self->{policy};
}
+# 'policy' => {
+# 'checkout' => 'true',
+# 'retries' => 5,
+# 'checkin' => 'true',
+# 'timeout' => 25,
+# 'status_update' => 'false',
+# 'offline' => 'false',
+# 'renewal' => 'true'
+# },
+
sub parms {
my $self = shift;
return $self->{parms};
diff --git a/C4/SIP/Sip/Constants.pm b/C4/SIP/Sip/Constants.pm
index f210046..ee58b44 100644
--- a/C4/SIP/Sip/Constants.pm
+++ b/C4/SIP/Sip/Constants.pm
@@ -13,179 +13,91 @@ use Exporter;
our (@ISA, @EXPORT_OK, %EXPORT_TAGS);
- at ISA = qw(Exporter);
+BEGIN {
+ @ISA = qw(Exporter);
+ %EXPORT_TAGS = (
- at 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
+ SC_msgs => [qw(
+ PATRON_STATUS_REQ
+ CHECKOUT CHECKIN
+ SC_STATUS REQUEST_ACS_RESEND
+ LOGIN PATRON_INFO END_PATRON_SESSION
+ FEE_PAID ITEM_INFORMATION ITEM_STATUS_UPDATE
+ HOLD RENEW RENEW_ALL
+ PATRON_ENABLE
+ BLOCK_PATRON
+ )],
- FID_PATRON_BIRTHDATE FID_PATRON_CLASS FID_INET_PROFILE
+ 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
+ HOLD_RESP RENEW_RESP RENEW_ALL_RESP
+ PATRON_ENABLE_RESP
+ )],
- SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN
- SIP_DATETIME);
+ SC_status => [qw(SC_STATUS_OK SC_STATUS_PAPER SC_STATUS_SHUTDOWN)],
+ formats => [qw(SIP_DATETIME)],
+ constant_msgs => [qw(REQUEST_ACS_RESEND_CKSUM REQUEST_SC_RESEND_CKSUM)],
-%EXPORT_TAGS = (
+ field_ids => [qw(
+ FID_PATRON_ID FID_ITEM_ID
+ FID_TERMINAL_PWD FID_PATRON_PWD
+ FID_PERSONAL_NAME FID_DUE_DATE
+ FID_SCREEN_MSG FID_PRINT_LINE
+ FID_TITLE_ID FID_BLOCKED_CARD_MSG
+ FID_TERMINAL_LOCN FID_INST_ID
+ FID_CURRENT_LOCN FID_LIBRARY_NAME
+ FID_PERM_LOCN
+ FID_HOLD_ITEMS FID_HOLD_ITEMS_LMT
+ FID_OVERDUE_ITEMS FID_OVERDUE_ITEMS_LMT
+ FID_CHARGED_ITEMS FID_CHARGED_ITEMS_LMT
+ 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_FEE_LMT
+ FID_EXPIRATION
+ FID_SUPPORTED_MSGS
+ FID_HOLD_TYPE
+ FID_UNAVAILABLE_HOLD_ITEMS
+ FID_HOLD_QUEUE_LEN
+ FID_FEE_ID FID_ITEM_PROPS
+ FID_RECALL_DATE FID_SECURITY_INHIBIT
+ 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_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)],
+ FID_COLLECTION_CODE
+ FID_CALL_NUMBER
+ FID_DESTINATION_LOCATION
+ FID_ALERT_TYPE
+ FID_HOLD_PATRON_ID
+ FID_HOLD_PATRON_NAME
+ )],
+ );
- 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
- )]);
+ # Add the contents of the other ":class" tags to make an ":all" class (deleting duplicates)
+ # This is the textbook example from http://perldoc.perl.org/Exporter.html
+ my %seen;
+ push @{$EXPORT_TAGS{all}}, grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
+ Exporter::export_ok_tags('all'); # now add :all to @EXPORT_OK
+}
#
# Declare message types
@@ -318,16 +230,24 @@ use constant {
FID_PATRON_BIRTHDATE => 'PB',
FID_PATRON_CLASS => 'PC',
- # SIP Extension for reporting patron internet privileges
+ # SIP Extension for reporting patron internet privileges... application unknown
FID_INET_PROFILE => 'PI',
+
+ # SIP Extensions by 3M spec: Document Revision 1.20, 02/14/2005
+ FID_COLLECTION_CODE => 'CR',
+ FID_CALL_NUMBER => 'CS',
+ FID_DESTINATION_LOCATION => 'CT',
+ FID_ALERT_TYPE => 'CV',
+ FID_HOLD_PATRON_ID => 'CY',
+ FID_HOLD_PATRON_NAME => 'DA',
};
#
# SC Status Codes
#
use constant {
- SC_STATUS_OK => '0',
- SC_STATUS_PAPER => '1',
+ SC_STATUS_OK => '0',
+ SC_STATUS_PAPER => '1',
SC_STATUS_SHUTDOWN => '2',
};
@@ -337,3 +257,5 @@ use constant {
use constant {
SIP_DATETIME => "%Y%m%d %H%M%S",
};
+
+1;
diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm
index 44a0034..16b1506 100644
--- a/C4/SIP/Sip/MsgType.pm
+++ b/C4/SIP/Sip/MsgType.pm
@@ -24,7 +24,7 @@ use UNIVERSAL qw(can); # make sure this is *after* C4 modules.
use vars qw(@ISA $VERSION @EXPORT_OK);
BEGIN {
- $VERSION = 1.00;
+ $VERSION = 1.01;
@ISA = qw(Exporter);
@EXPORT_OK = qw(handle);
}
@@ -331,7 +331,7 @@ sub _initialize {
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) ];
+ $self->{fixed_fields} = [ unpack($proto->{template}, $msg) ]; # see http://perldoc.perl.org/5.8.8/functions/unpack.html
# Skip over the fixed fields and the split the rest of
# the message into fields based on the delimiter and parse them
@@ -621,14 +621,11 @@ sub handle_checkin {
$ils->check_inst_id($inst_id, "handle_checkin");
if ($no_block eq 'Y') {
- # Off-line transactions, ick.
- syslog("LOG_WARNING", "received no-block checkin from terminal '%s'",
- $account->{id});
- $status = $ils->checkin_no_block($item_id, $trans_date,
- $return_date, $item_props, $cancel);
+ # Off-line transactions, ick.
+ syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
+ $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
} else {
- $status = $ils->checkin($item_id, $trans_date, $return_date,
- $current_loc, $item_props, $cancel);
+ $status = $ils->checkin($item_id, $trans_date, $return_date, $current_loc, $item_props, $cancel);
}
$patron = $status->patron;
@@ -649,19 +646,25 @@ sub handle_checkin {
$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);
+ $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_SORT_BIN, $status->sort_bin);
+ if ($patron) {
+ $resp .= add_field(FID_PATRON_ID, $patron->id);
+ }
+ if ($item) {
+ $resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type );
+ $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
+ # $resp .= maybe_add(FID_COLLECTION_CODE, $item->collection_code );
+ # $resp .= maybe_add(FID_CALL_NUMBER, $item->call_number );
+ # $resp .= maybe_add(FID_DESTINATION, $item->destination_loc );
+ # $resp .= maybe_add(FID_ALERT_TYPE, $item->alert_type );
+ # $resp .= maybe_add(FID_PATRON_ID, $item->hold_patron_id );
+ # $resp .= maybe_add(FID_PATRON_NAME, $item->hold_patron_name );
+ }
}
$resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
@@ -841,59 +844,6 @@ sub handle_login {
}
else { $status = login_core($server,$uid,$pwd); }
-=pod
-
-Note: This block was commented out with improperly formatted POD. It
-was not interpreted by perl, but not properly handled by POD
-formatters. I fixed the POD syntax error so this code is now obviously
-a comment and not code. The code has been extracted to the login_core
-sub and is called above. -- amoore Aug 12, 2008
-
- 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};
- $server->{sip_username} = $uid;
- $server->{sip_password} = $pwd;
-
- my $auth_status = api_auth($uid,$pwd);
- if (!$auth_status or $auth_status !~ /^ok$/i) {
- syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s",
- $uid, $inst, ($auth_status||'unknown'));
- $status = 0;
- } else {
- syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst);
- #
- # initialize connection to ILS
- #
- my $module = $server->{config}->{institutions}->{$inst}->{implementation};
- syslog("LOG_DEBUG", 'handle_login: ' . Dumper($module));
- $module->use;
- if ($@) {
- syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
- $server->{service}, $module, $inst);
- die("Failed to load ILS implementation '$module' for $inst");
- }
-
- # like ILS->new(), I think.
- $server->{ils} = $module->new($server->{institution}, $server->{account});
- if (!$server->{ils}) {
- syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
- die("Unable to connect to ILS '$inst'");
- }
- }
- }
-
-=cut
-
$self->write_msg(LOGIN_RESP . $status);
return $status ? LOGIN : '';
}
@@ -908,44 +858,34 @@ sub and is called above. -- amoore Aug 12, 2008
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 },
- );
-
+ { 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 '';
+ return ''; # No detailed information required
}
syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
- $summary_type, $summary_map[$summary_type]->{fid});
+ $summary_type, $summary_map[$summary_type]->{fid});
- $func = $summary_map[$summary_type]->{func};
- $fid = $summary_map[$summary_type]->{fid};
- $itemlist = &$func($patron, $start, $end);
+ my $func = $summary_map[$summary_type]->{func};
+ my $fid = $summary_map[$summary_type]->{fid};
+ my $itemlist = &$func($patron, $start, $end);
syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
foreach my $i (@{$itemlist}) {
- $resp .= add_field($fid, $i);
+ $resp .= add_field($fid, $i);
}
return $resp;
@@ -971,7 +911,8 @@ sub handle_patron_info {
$resp = (PATRON_INFO_RESP);
if ($patron) {
$resp .= patron_status_string($patron);
- $resp .= $lang . Sip::timestamp();
+ $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
+ $resp .= Sip::timestamp();
$resp .= add_count('patron_info/hold_items',
scalar @{$patron->hold_items});
@@ -986,67 +927,70 @@ sub handle_patron_info {
$resp .= add_count('patron_info/unavail_holds',
scalar @{$patron->unavail_holds});
+ # FID_INST_ID added last (order irrelevant for fields w/ identifiers)
+
# while the patron ID we got from the SC is valid, let's
# use the one returned from the ILS, just in case...
- $resp .= add_field(FID_PATRON_ID, $patron->id);
-
+ $resp .= add_field(FID_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);
+ # hold items limit
+ # overdue items limit
+ # charged items limit
$resp .= add_field(FID_VALID_PATRON, 'Y');
if (defined($patron_pwd)) {
- # If the patron password was provided, report on if
- # it was right.
+ # If patron password was provided, report whether it was right or not.
$resp .= add_field(FID_VALID_PATRON_PWD,
sipbool($patron->check_password($patron_pwd)));
}
+ $resp .= maybe_add(FID_CURRENCY, $patron->currency);
+ $resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount);
+ $resp .= add_field(FID_FEE_LMT, $patron->fee_limit);
+
+ # TODO: zero or more item details for 2.0 can go here:
+ # hold_items
+ # overdue_items
+ # charged_items
+ # fine_items
+ # recall_items
+
+ $resp .= summary_info($ils, $patron, $summary, $start, $end);
+
+ $resp .= maybe_add(FID_HOME_ADDR, $patron->address);
+ $resp .= maybe_add(FID_EMAIL, $patron->email_addr);
+ $resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
+
# SIP 2.0 extensions used by Envisionware
- # Other 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);
+ # Other terminals will ignore unrecognized fields (unrecognized field identifiers)
+ $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->birthdate);
+ $resp .= maybe_add(FID_PATRON_CLASS, $patron->ptype);
# Custom protocol extension to report patron internet privileges
- $resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
+ $resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
- $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
- $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
+ $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');
- }
+ # Invalid patron ID:
+ # no privileges, no items associated,
+ # no personal name, and is invalid (if we're using 2.00)
+ $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
+ $resp .= '0000' x 6;
+
+ # patron ID is invalid, but field is required, so just echo it back
+ $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
+ $resp .= add_field(FID_PERSONAL_NAME, '');
+
+ if ($protocol_version >= 2) {
+ $resp .= add_field(FID_VALID_PATRON, 'N');
+ }
}
- $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
-
+ $resp .= add_field(FID_INST_ID, ($ils->institution_id || 'SIP2'));
$self->write_msg($resp);
-
return(PATRON_INFO);
}
@@ -1597,23 +1541,24 @@ 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));
+ 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;
}
diff --git a/C4/SIP/t/SIPtest.pm b/C4/SIP/t/SIPtest.pm
index 5c432b0..193aa5b 100644
--- a/C4/SIP/t/SIPtest.pm
+++ b/C4/SIP/t/SIPtest.pm
@@ -69,7 +69,7 @@ our $user_fullname= 'Edna Acosta';
our $user_homeaddr= '7896 Library Rd\.';
our $user_email = 'patron\@liblime\.com';
our $user_phone = '\(212\) 555-1212';
-our $user_birthday= '1980-04-24';
+our $user_birthday= '19800424'; # YYYYMMDD, ANSI X3.30
our $user_ptype = 'PT';
our $user_inet = 'Y';
@@ -80,7 +80,7 @@ our $user2_fullname= 'Jamie White';
our $user2_homeaddr= '937 Library Rd\.';
our $user2_email = 'patron\@liblime\.com';
our $user2_phone = '\(212\) 555-1212';
-our $user2_birthday= '1950-04-22';
+our $user2_birthday= '19500422'; # YYYYMMDD, ANSI X3.30
our $user2_ptype = 'T';
our $user2_inet = 'Y';
--
1.5.6.5
More information about the Koha-patches
mailing list