3M SIP2 Extensions groundwork and Patron Info popoulation
authorJoe Atzberger <joe.atzberger@liblime.com>
Wed, 22 Jul 2009 14:08:38 +0000 (09:08 -0500)
committerGalen Charlton <galen.charlton@liblime.com>
Wed, 22 Jul 2009 14:14:49 +0000 (10:14 -0400)
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.

This work was sponsored by the Northeast Kansas Library System.

Signed-off-by: Galen Charlton <galen.charlton@liblime.com>
C4/SIP/ILS.pm
C4/SIP/ILS/Patron.pm
C4/SIP/ILS/Transaction/Checkin.pm
C4/SIP/SIPServer.pm
C4/SIP/Sip/Configuration/Institution.pm
C4/SIP/Sip/Constants.pm
C4/SIP/Sip/MsgType.pm
C4/SIP/t/SIPtest.pm

index 4315540..09c454f 100644 (file)
@@ -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});
 
index 682248e..abdb7e9 100644 (file)
@@ -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
 #
index bcf5c78..6c4f360 100644 (file)
@@ -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;
index b872e77..55b2380 100644 (file)
@@ -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())) {
index cdd8a08..1e50af2 100644 (file)
@@ -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};
index f210046..ee58b44 100644 (file)
@@ -13,179 +13,91 @@ use Exporter;
 
 our (@ISA, @EXPORT_OK, %EXPORT_TAGS);
 
-@ISA = qw(Exporter);
+BEGIN {
+    @ISA         = qw(Exporter);
+    %EXPORT_TAGS = (
 
-@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;
index 44a0034..16b1506 100644 (file)
@@ -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;
 }
 
index 5c432b0..193aa5b 100644 (file)
@@ -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';