Sip/MsgType.pm

   1 #
   2 # Copyright (C) 2006-2008  Georgia Public Library Service
   3 #
   4 # Author: David J. Fiander
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 #
  19 # Sip::MsgType.pm
  20 #
  21 # A Class for handing SIP messages
  22 #
  23
  24 package Sip::MsgType;
  25
  26 use strict;
  27 use warnings;
  28 use Exporter;
  29 use Sys::Syslog qw(syslog);
  30
  31 use Sip qw(:all);
  32 use Sip::Constants qw(:all);
  33 use Sip::Checksum qw(verify_cksum);
  34
  35 use Data::Dumper;
  36
  37 our (@ISA, @EXPORT_OK, $VERSION);
  38
  39 @ISA = qw(Exporter);
  40 @EXPORT_OK = qw(handle);
  41 $VERSION = 0.02;
  42
  43 # Predeclare handler subroutines
  44 use subs qw(handle_patron_status handle_checkout handle_checkin
  45             handle_block_patron handle_sc_status handle_request_acs_resend
  46             handle_login handle_patron_info handle_end_patron_session
  47             handle_fee_paid handle_item_information handle_item_status_update
  48             handle_patron_enable handle_hold handle_renew handle_renew_all);
  49
  50 #
  51 # For the most part, Version 2.00 of the protocol just adds new
  52 # variable fields, but sometimes it changes the fixed header.
  53 #
  54 # In general, if there's no '2.00' protocol entry for a handler, that's
  55 # because 2.00 didn't extend the 1.00 version of the protocol.  This will
  56 # be handled by the module initialization code following the declaration,
  57 # which goes through the handlers table and creates a '2.00' entry that
  58 # points to the same place as the '1.00' entry.  If there's a 2.00 entry
  59 # but no 1.00 entry, then that means that it's a completely new service
  60 # in 2.00, so 1.00 shouldn't recognize it.
  61
  62 my %handlers = (
  63                 (PATRON_STATUS_REQ) => {
  64                     name => "Patron Status Request",
  65                     handler => \&handle_patron_status,
  66                     protocol => {
  67                         1 => {
  68                             template => "A3A18",
  69                             template_len => 21,
  70                             fields => [(FID_INST_ID), (FID_PATRON_ID),
  71                                        (FID_TERMINAL_PWD), (FID_PATRON_PWD)],
  72                         }
  73                     }
  74                 },
  75                 (CHECKOUT) => {
  76                     name => "Checkout",
  77                     handler => \&handle_checkout,
  78                     protocol => {
  79                         1 => {
  80                             template => "CCA18A18",
  81                             template_len => 38,
  82                             fields => [(FID_INST_ID), (FID_PATRON_ID),
  83                                        (FID_ITEM_ID), (FID_TERMINAL_PWD)],
  84                         },
  85                         2 => {
  86                             template => "CCA18A18",
  87                             template_len => 38,
  88                             fields => [(FID_INST_ID), (FID_PATRON_ID),
  89                                        (FID_ITEM_ID), (FID_TERMINAL_PWD),
  90                                        (FID_ITEM_PROPS), (FID_PATRON_PWD),
  91                                        (FID_FEE_ACK), (FID_CANCEL)],
  92                         },
  93                     }
  94                 },
  95                 (CHECKIN) => {
  96                     name => "Checkin",
  97                     handler => \&handle_checkin,
  98                     protocol => {
  99                         1 => {
 100                             template => "CA18A18",
 101                             template_len => 37,
 102                             fields => [(FID_CURRENT_LOCN), (FID_INST_ID),
 103                                        (FID_ITEM_ID), (FID_TERMINAL_PWD)],
 104                         },
 105                         2 => {
 106                             template => "CA18A18",
 107                             template_len => 37,
 108                             fields => [(FID_CURRENT_LOCN), (FID_INST_ID),
 109                                        (FID_ITEM_ID), (FID_TERMINAL_PWD),
 110                                        (FID_ITEM_PROPS), (FID_CANCEL)],
 111                         }
 112                     }
 113                 },
 114                 (BLOCK_PATRON) => {
 115                     name => "Block Patron",
 116                     handler => \&handle_block_patron,
 117                     protocol => {
 118                         1 => {
 119                             template => "CA18",
 120                             template_len => 19,
 121                             fields => [(FID_INST_ID), (FID_BLOCKED_CARD_MSG),
 122                                        (FID_PATRON_ID), (FID_TERMINAL_PWD)],
 123                         },
 124                     }
 125                 },
 126                 (SC_STATUS) => {
 127                     name => "SC Status",
 128                     handler => \&handle_sc_status,
 129                     protocol => {
 130                         1 => {
 131                             template =>"CA3A4",
 132                             template_len => 8,
 133                             fields => [],
 134                         }
 135                     }
 136                 },
 137                 (REQUEST_ACS_RESEND) => {
 138                     name => "Request ACS Resend",
 139                     handler => \&handle_request_acs_resend,
 140                     protocol => {
 141                         1 => {
 142                             template => "",
 143                             template_len => 0,
 144                             fields => [],
 145                         }
 146                     }
 147                 },
 148                 (LOGIN) => {
 149                     name => "Login",
 150                     handler => \&handle_login,
 151                     protocol => {
 152                         2 => {
 153                             template => "A1A1",
 154                             template_len => 2,
 155                             fields => [(FID_LOGIN_UID), (FID_LOGIN_PWD),
 156                                        (FID_LOCATION_CODE)],
 157                         }
 158                     }
 159                 },
 160                 (PATRON_INFO) => {
 161                     name => "Patron Info",
 162                     handler => \&handle_patron_info,
 163                     protocol => {
 164                         2 => {
 165                             template => "A3A18A10",
 166                             template_len => 31,
 167                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 168                                        (FID_TERMINAL_PWD), (FID_PATRON_PWD),
 169                                        (FID_START_ITEM), (FID_END_ITEM)],
 170                         }
 171                     }
 172                 },
 173                 (END_PATRON_SESSION) => {
 174                     name => "End Patron Session",
 175                     handler => \&handle_end_patron_session,
 176                     protocol => {
 177                         2 => {
 178                             template => "A18",
 179                             template_len => 18,
 180                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 181                                        (FID_TERMINAL_PWD), (FID_PATRON_PWD)],
 182                         }
 183                     }
 184                 },
 185                 (FEE_PAID) => {
 186                     name => "Fee Paid",
 187                     handler => \&handle_fee_paid,
 188                     protocol => {
 189                         2 => {
 190                             template => "A18A2A2A3",
 191                             template_len => 25,
 192                             fields => [(FID_FEE_AMT), (FID_INST_ID),
 193                                        (FID_PATRON_ID), (FID_TERMINAL_PWD),
 194                                        (FID_PATRON_PWD), (FID_FEE_ID),
 195                                        (FID_TRANSACTION_ID)],
 196                         }
 197                     }
 198                 },
 199                 (ITEM_INFORMATION) => {
 200                     name => "Item Information",
 201                     handler => \&handle_item_information,
 202                     protocol => {
 203                         2 => {
 204                             template => "A18",
 205                             template_len => 18,
 206                             fields => [(FID_INST_ID), (FID_ITEM_ID),
 207                                        (FID_TERMINAL_PWD)],
 208                         }
 209                     }
 210                 },
 211                 (ITEM_STATUS_UPDATE) => {
 212                     name => "Item Status Update",
 213                     handler => \&handle_item_status_update,
 214                     protocol => {
 215                         2 => {
 216                             template => "A18",
 217                             template_len => 18,
 218                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 219                                        (FID_ITEM_ID), (FID_TERMINAL_PWD),
 220                                        (FID_ITEM_PROPS)],
 221                         }
 222                     }
 223                 },
 224                 (PATRON_ENABLE) => {
 225                     name => "Patron Enable",
 226                     handler => \&handle_patron_enable,
 227                     protocol => {
 228                         2 => {
 229                             template => "A18",
 230                             template_len => 18,
 231                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 232                                        (FID_TERMINAL_PWD), (FID_PATRON_PWD)],
 233                         }
 234                     }
 235                 },
 236                 (HOLD) => {
 237                     name => "Hold",
 238                     handler => \&handle_hold,
 239                     protocol => {
 240                         2 => {
 241                             template => "AA18",
 242                             template_len => 19,
 243                             fields => [(FID_EXPIRATION), (FID_PICKUP_LOCN),
 244                                        (FID_HOLD_TYPE), (FID_INST_ID),
 245                                        (FID_PATRON_ID), (FID_PATRON_PWD),
 246                                        (FID_ITEM_ID), (FID_TITLE_ID),
 247                                        (FID_TERMINAL_PWD), (FID_FEE_ACK)],
 248                         }
 249                     }
 250                 },
 251                 (RENEW) => {
 252                     name => "Renew",
 253                     handler => \&handle_renew,
 254                     protocol => {
 255                         2 => {
 256                             template => "CCA18A18",
 257                             template_len => 38,
 258                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 259                                        (FID_PATRON_PWD), (FID_ITEM_ID),
 260                                        (FID_TITLE_ID), (FID_TERMINAL_PWD),
 261                                        (FID_ITEM_PROPS), (FID_FEE_ACK)],
 262                         }
 263                     }
 264                 },
 265                 (RENEW_ALL) => {
 266                     name => "Renew All",
 267                     handler => \&handle_renew_all,
 268                     protocol => {
 269                         2 => {
 270                             template => "A18",
 271                             template_len => 18,
 272                             fields => [(FID_INST_ID), (FID_PATRON_ID),
 273                                        (FID_PATRON_PWD), (FID_TERMINAL_PWD),
 274                                        (FID_FEE_ACK)],
 275                         }
 276                     }
 277                 }
 278                 );
 279
 280 #
 281 # Now, initialize some of the missing bits of %handlers
 282 #
 283 foreach my $i (keys(%handlers)) {
 284     if (!exists($handlers{$i}->{protocol}->{2})) {
 285
 286         $handlers{$i}->{protocol}->{2} = $handlers{$i}->{protocol}->{1};
 287     }
 288 }
 289
 290 # Stolen from ../ILS.pm, useful in here as well
 291 sub to_bool {
 292     my $bool = shift;
 293
 294     # If it's defined, and matches a true sort of string, or is
 295     # a non-zero number, then it's true.
 296     return defined($bool) && (($bool =~ /true|y|yes/i) || $bool != 0);
 297 }
 298
 299 sub new {
 300     my ($class, $msg, $seqno) = @_;
 301     my $self = {};
 302     my $msgtag = substr($msg, 0, 2);
 303
 304     syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s', '%s'): msgtag '%s'",
 305            $class, substr($msg, 0, 10), $msgtag, $seqno);
 306     if ($msgtag eq LOGIN) {
 307         # If the client is using the 2.00-style "Login" message
 308         # to authenticate to the server, then we get the Login message
 309         # _before_ the client has indicated that it supports 2.00, but
 310         # it's using the 2.00 login process, so it must support 2.00,
 311         # so we'll just do it.
 312         $protocol_version = 2;
 313     }
 314     if (!exists($handlers{$msgtag})) {
 315         syslog("LOG_WARNING",
 316                "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'",
 317                $msgtag, $msg);
 318         return(undef);
 319     } elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) {
 320         syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
 321                $msgtag, $protocol_version);
 322         return(undef);
 323     }
 324
 325     bless $self, $class;
 326
 327     $self->{seqno} = $seqno;
 328     $self->_initialize(substr($msg,2), $handlers{$msgtag});
 329
 330     return($self);
 331 }
 332
 333 sub _initialize {
 334     my ($self, $msg, $control_block) = @_;
 335     my ($fs, $fn, $fe);
 336     my $proto = $control_block->{protocol}->{$protocol_version};
 337
 338     $self->{name}    = $control_block->{name};
 339     $self->{handler} = $control_block->{handler};
 340
 341     $self->{fields} = {};
 342     $self->{fixed_fields} = [];
 343
 344     syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s...')", $self->{name}, substr($msg,0,20));
 345
 346
 347     foreach my $field (@{$proto->{fields}}) {
 348         $self->{fields}->{$field} = undef;
 349     }
 350
 351     syslog("LOG_DEBUG",
 352            "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...",
 353            $self->{name}, $msg, $proto->{template},
 354            $proto->{template_len});
 355
 356     $self->{fixed_fields} = [ unpack($proto->{template}, $msg) ];
 357
 358     # Skip over the fixed fields and the split the rest of
 359     # the message into fields based on the delimiter and parse them
 360     foreach my $field (split(quotemeta($field_delimiter), substr($msg, $proto->{template_len}))) {
 361         $fn = substr($field, 0, 2);
 362
 363         if (!exists($self->{fields}->{$fn})) {
 364             syslog("LOG_WARNING",
 365                    "Unsupported field '%s' in %s message '%s'",
 366                    $fn, $self->{name}, $msg);
 367         } elsif (defined($self->{fields}->{$fn})) {
 368             syslog("LOG_WARNING",
 369                    "Duplicate field '%s' (previous value '%s') in %s message '%s'",
 370                    $fn, $self->{fields}->{$fn}, $self->{name}, $msg);
 371         } else {
 372             $self->{fields}->{$fn} = substr($field, 2);
 373         }
 374     }
 375
 376     return($self);
 377 }
 378
 379 sub handle {
 380     my ($msg, $server, $req) = @_;
 381     my $config = $server->{config};
 382     my $self;
 383
 384
 385     #
 386     # What's the field delimiter for variable length fields?
 387     # This can't be based on the account, since we need to know
 388     # the field delimiter to parse a SIP login message
 389     #
 390     if (defined($server->{config}->{delimiter})) {
 391         $field_delimiter = $server->{config}->{delimiter};
 392     }
 393
 394     # error detection is active if this is a REQUEST_ACS_RESEND
 395     # message with a checksum, or if the message is long enough
 396     # and the last nine characters begin with a sequence number
 397     # field
 398     if ($msg eq REQUEST_ACS_RESEND_CKSUM) {
 399         # Special case
 400
 401         $error_detection = 1;
 402         $self = new Sip::MsgType ((REQUEST_ACS_RESEND), 0);
 403     } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) {
 404         $error_detection = 1;
 405
 406         if (!verify_cksum($msg)) {
 407             syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg);
 408             # REQUEST_SC_RESEND with error detection
 409             $last_response = REQUEST_SC_RESEND_CKSUM;
 410             print("$last_response\r");
 411             return REQUEST_ACS_RESEND;
 412         } else {
 413             # Save the sequence number, then strip off the
 414             # error detection data to process the message
 415             $self = new Sip::MsgType (substr($msg, 0, -9), substr($msg, -7, 1));
 416         }
 417     } elsif ($error_detection) {
 418         # We've receive a non-ED message when ED is supposed
 419         # to be active.  Warn about this problem, then process
 420         # the message anyway.
 421         syslog("LOG_WARNING",
 422                "Received message without error detection: '%s'", $msg);
 423         $error_detection = 0;
 424         $self = new Sip::MsgType ($msg, 0);
 425     } else {
 426         $self = new Sip::MsgType ($msg, 0);
 427     }
 428
 429     if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) &&
 430         $req && (substr($msg, 0, 2) ne $req)) {
 431         return substr($msg, 0, 2);
 432     }
 433     return($self->{handler}->($self, $server));
 434 }
 435
 436 ##
 437 ## Message Handlers
 438 ##
 439
 440 #
 441 # Patron status messages are produced in response to both
 442 # "Request Patron Status" and "Block Patron"
 443 #
 444 # Request Patron Status requires a patron password, but
 445 # Block Patron doesn't (since the patron may never have
 446 # provided one before attempting some illegal action).
 447 #
 448 # ASSUMPTION: If the patron password field is present in the
 449 # message, then it must match, otherwise incomplete patron status
 450 # information will be returned to the terminal.
 451 #
 452 sub build_patron_status {
 453     my ($patron, $lang, $fields, $server)= @_;
 454     $lang ||= '000';
 455     my $patron_pwd = $fields->{(FID_PATRON_PWD)};
 456     my $resp = (PATRON_STATUS_RESP);
 457
 458     if ($patron) {
 459         $resp .= patron_status_string($patron);
 460         $resp .= $lang . Sip::timestamp();
 461
 462         # while the patron ID we got from the SC is valid, let's
 463         # use the one returned from the ILS, just in case...
 464         $resp .= add_field(FID_INST_ID, $fields->{(FID_INST_ID)});
 465         $resp .= add_field(FID_PATRON_ID, $patron->id);
 466         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
 467         if ($protocol_version >= 2) {
 468             $resp .= add_field(FID_VALID_PATRON, 'Y');
 469             # Patron password is a required field.
 470                 $resp .= add_field(FID_VALID_PATRON_PWD, sipbool($patron->check_password($patron_pwd)));
 471             $resp .= maybe_add(FID_CURRENCY, $patron->currency);
 472             $resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount);
 473
 474                 # Relais extensions
 475                 if ($server->{institution}->relais_extensions_to_msg24()) {
 476                         $resp .= maybe_add(FID_HOME_ADDR,  $patron->address   );
 477                         $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
 478                         $resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
 479                 }
 480
 481         }
 482
 483         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
 484         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
 485     } else {
 486         # Invalid patron id.  Report that the user has no privs.,
 487         # no personal name, and is invalid (if we're using 2.00)
 488         $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
 489         $resp .= add_field(FID_INST_ID, $fields->{(FID_INST_ID)});
 490
 491         # the patron ID is invalid, but it's a required field, so
 492         # just echo it back
 493         $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
 494         $resp .= add_field(FID_PERSONAL_NAME, '');
 495
 496         if ($protocol_version >= 2) {
 497             $resp .= add_field(FID_VALID_PATRON, 'N');
 498         }
 499     }
 500
 501
 502     return $resp;
 503 }
 504
 505 sub handle_patron_status {
 506     my ($self, $server) = @_;
 507     my $ils = $server->{ils};
 508     my ($lang, $date);
 509     my $fields;
 510     my $patron;
 511     my $resp = (PATRON_STATUS_RESP);
 512
 513     ($lang, $date) = @{$self->{fixed_fields}};
 514     $fields = $self->{fields};
 515
 516     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_patron_status");
 517
 518     $patron = $ils->find_patron($fields->{(FID_PATRON_ID)});
 519
 520     $resp = build_patron_status($patron, $lang, $fields, $server);
 521
 522     $self->write_msg($resp, undef, $server->{encoding});
 523
 524     return (PATRON_STATUS_REQ);
 525 }
 526
 527 sub handle_checkout {
 528     my ($self, $server) = @_;
 529     my $account = $server->{account};
 530     my $ils = $server->{ils};
 531     my $inst = $ils->institution;
 532     my ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date);
 533     my $fields;
 534     my ($patron_id, $item_id, $status, $fee_ack);
 535     my ($item, $patron);
 536     my $resp;
 537
 538     ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date) =
 539         @{$self->{fixed_fields}};
 540     $fields = $self->{fields};
 541
 542     $patron_id = $fields->{(FID_PATRON_ID)};
 543     $item_id   = $fields->{(FID_ITEM_ID)};
 544     $fee_ack = $fields->{(FID_FEE_ACK)};
 545
 546
 547     if ($no_block eq 'Y') {
 548         # Off-line transactions need to be recorded, but there's
 549         # not a lot we can do about it
 550         syslog("LOG_WARNING", "received no-block checkout from terminal '%s'",
 551                $account->{id});
 552
 553         $status = $ils->checkout_no_block($patron_id, $item_id,
 554                                           $sc_renewal_policy,
 555                                           $trans_date, $nb_due_date);
 556     } else {
 557         # Does the transaction date really matter for items that are
 558         # checkout out while the terminal is online?  I'm guessing 'no'
 559         $status = $ils->checkout($patron_id, $item_id, $sc_renewal_policy, $fee_ack);
 560     }
 561
 562
 563     $item   = $status->item;
 564     $patron = $status->patron;
 565
 566     if ($status->ok) {
 567         # Item successfully checked out
 568         # Fixed fields
 569         $resp = CHECKOUT_RESP . '1';
 570         $resp .= sipbool($status->renew_ok);
 571         if ($ils->supports('magnetic media')) {
 572             $resp .= sipbool($item->magnetic);
 573         } else {
 574             $resp .= 'U';
 575         }
 576         # We never return the obsolete 'U' value for 'desensitize'
 577         $resp .= sipbool($status->desensitize);
 578         $resp .= Sip::timestamp;
 579
 580         # Now for the variable fields
 581         $resp .= add_field(FID_INST_ID,  $inst);
 582         $resp .= add_field(FID_PATRON_ID, $patron_id);
 583         $resp .= add_field(FID_ITEM_ID,  $item_id);
 584         $resp .= add_field(FID_TITLE_ID, $item->title_id);
 585         $resp .= add_field(FID_DUE_DATE, $item->due_date);
 586
 587         $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 588         $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 589
 590         if ($protocol_version >= 2) {
 591             if ($ils->supports('security inhibit')) {
 592                 $resp .= add_field(FID_SECURITY_INHIBIT, $status->security_inhibit);
 593             }
 594             $resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type);
 595             $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
 596
 597             # Financials
 598             if ($status->fee_amount) {
 599                 $resp .= add_field(FID_FEE_AMT,  $status->fee_amount);
 600                 $resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
 601                 $resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
 602                 $resp .= maybe_add(FID_TRANSACTION_ID,
 603                                    $status->transaction_id);
 604             }
 605         }
 606
 607     } else {
 608         # Checkout failed
 609         # Checkout Response: not ok, no renewal, don't know mag. media,
 610         # no desensitize
 611         $resp = sprintf("120%sUN%s", sipbool($status->renew_ok), Sip::timestamp);
 612         $resp .= add_field(FID_INST_ID, $inst);
 613         $resp .= add_field(FID_PATRON_ID, $patron_id);
 614         $resp .= add_field(FID_ITEM_ID, $item_id);
 615
 616         # If the item is valid, provide the title, otherwise
 617         # leave it blank
 618         $resp .= add_field(FID_TITLE_ID, $item ? $item->title_id : '');
 619         # Due date is required.  Since it didn't get checked out,
 620         # it's not due, so leave the date blank
 621         $resp .= add_field(FID_DUE_DATE, '');
 622
 623         $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 624         $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 625
 626         if ($protocol_version >= 2) {
 627             # Is the patron ID valid?
 628             $resp .= add_field(FID_VALID_PATRON, sipbool($patron));
 629
 630             if ($patron && exists($fields->{FID_PATRON_PWD})) {
 631                 # Password provided, so we can tell if it was valid or not
 632                 $resp .= add_field(FID_VALID_PATRON_PWD,
 633                                    sipbool($patron->check_password($fields->{(FID_PATRON_PWD)})));
 634             }
 635             # For the patron to accept a fee in chargeable loans, we
 636             # need to return fee information.
 637             if ($status->fee_amount) {
 638                 $resp .= add_field(FID_FEE_AMT,  $status->fee_amount);
 639                 $resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
 640                 $resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
 641             }
 642         }
 643     }
 644
 645     $self->write_msg($resp, undef, $server->{encoding});
 646     return(CHECKOUT);
 647 }
 648
 649 sub handle_checkin {
 650     my ($self, $server) = @_;
 651     my $account = $server->{account};
 652     my $ils     = $server->{ils};
 653     my ($current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel);
 654     my ($patron, $item, $status);
 655     my $resp = CHECKIN_RESP;
 656
 657     my ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}};
 658     my $fields = $self->{fields};
 659
 660     $current_loc = $fields->{(FID_CURRENT_LOCN)};
 661     $inst_id     = $fields->{(FID_INST_ID)     };
 662     $item_id     = $fields->{(FID_ITEM_ID)     };
 663     $item_props  = $fields->{(FID_ITEM_PROPS)  };
 664     $cancel      = $fields->{(FID_CANCEL)      };
 665
 666     $ils->check_inst_id($inst_id, "handle_checkin");
 667
 668     if ($no_block eq 'Y') {
 669         # Off-line transactions, ick.
 670         syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
 671         $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
 672     } else {
 673         $status = $ils->checkin($item_id, $inst_id, $trans_date, $return_date, $current_loc, $item_props, $cancel);
 674     }
 675
 676     $patron = $status->patron;
 677     $item   = $status->item;
 678
 679     $resp .= $status->ok ? '1' : '0';
 680     $resp .= $status->resensitize ? 'Y' : 'N';
 681     if ($item && $ils->supports('magnetic media')) {
 682         $resp .= sipbool($item->magnetic);
 683     } else {
 684         # The item barcode was invalid or the system doesn't support
 685         # the 'magnetic media' indicator
 686         $resp .= 'U';
 687     }
 688     $resp .= $status->alert ? 'Y' : 'N';
 689     $resp .= Sip::timestamp;
 690     $resp .= add_field(FID_INST_ID, $inst_id);
 691     $resp .= add_field(FID_ITEM_ID, $item_id);
 692
 693     if ($item) {
 694         $resp .= add_field(FID_PERM_LOCN, $item->permanent_location);
 695         $resp .= maybe_add(FID_TITLE_ID, $item->title_id);
 696     }
 697
 698     if ($protocol_version >= 2) {
 699         $resp .= maybe_add(FID_SORT_BIN, $status->sort_bin);
 700         if ($patron) {
 701             $resp .= add_field(FID_PATRON_ID, $patron->id);
 702         }
 703         if ($item) {
 704             $resp .= maybe_add(FID_MEDIA_TYPE,           $item->sip_media_type     );
 705             $resp .= maybe_add(FID_ITEM_PROPS,           $item->sip_item_properties);
 706             $resp .= maybe_add(FID_COLLECTION_CODE,      $item->collection_code    );
 707             $resp .= maybe_add(FID_CALL_NUMBER,          $item->call_number        );
 708             $resp .= maybe_add(FID_DESTINATION_LOCATION, $item->destination_loc    );
 709             $resp .= maybe_add(FID_HOLD_PATRON_ID,       $item->hold_patron_bcode  );
 710             $resp .= maybe_add(FID_HOLD_PATRON_NAME,     $item->hold_patron_name   );
 711             if ($server->{institution}->phone_ext_to_msg10()) {
 712                 $resp .= maybe_add(FID_HOME_PHONE,           $item->hold_patron_phone  );
 713             }
 714         }
 715     }
 716
 717     $resp .= maybe_add(FID_ALERT_TYPE, $status->alert_type) if $status->alert;
 718     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 719     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 720
 721     $self->write_msg($resp, undef, $server->{encoding});
 722
 723     return(CHECKIN);
 724 }
 725
 726 sub handle_block_patron {
 727     my ($self, $server) = @_;
 728     my $ils     = $server->{ils};
 729     my ($card_retained, $trans_date);
 730     my ($inst_id, $blocked_card_msg, $patron_id, $terminal_pwd);
 731     my $fields;
 732     my $resp;
 733     my $patron;
 734
 735     ($card_retained, $trans_date) = @{$self->{fixed_fields}};
 736     $fields = $self->{fields};
 737     $inst_id          = $fields->{(FID_INST_ID)};
 738     $blocked_card_msg = $fields->{(FID_BLOCKED_CARD_MSG)};
 739     $patron_id        = $fields->{(FID_PATRON_ID)};
 740     $terminal_pwd     = $fields->{(FID_TERMINAL_PWD)};
 741
 742     # Terminal passwords are different from account login
 743     # passwords, but I have no idea what to do with them.  So,
 744     # I'll just ignore them for now.
 745
 746     $ils->check_inst_id($inst_id, "block_patron");
 747
 748     $patron = $ils->find_patron($patron_id);
 749
 750     # The correct response for a "Block Patron" message is a
 751     # "Patron Status Response", so use that handler to generate
 752     # the message, but then return the correct code from here.
 753     #
 754     # Normally, the language is provided by the "Patron Status"
 755     # fixed field, but since we're not responding to one of those
 756     # we'll just say, "Unspecified", as per the spec.  Let the
 757     # terminal default to something that, one hopes, will be
 758     # intelligible
 759     my $language = $patron ? $patron->language : '000';
 760     if ($patron) {
 761         # Valid patron id
 762         $patron->block($card_retained, $blocked_card_msg);
 763     }
 764
 765     $resp = build_patron_status($patron, $language, $fields, $server);
 766
 767     $self->write_msg($resp, undef, $server->{encoding});
 768     return(BLOCK_PATRON);
 769 }
 770
 771 sub handle_sc_status {
 772     my ($self, $server) = @_;
 773     my ($status, $print_width, $sc_protocol_version, $new_proto);
 774
 775     ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}};
 776
 777     if ($sc_protocol_version =~ /^1\./) {
 778         $new_proto = 1;
 779     } elsif ($sc_protocol_version =~ /^2\./) {
 780         $new_proto = 2;
 781     } else {
 782         syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
 783         $new_proto = 1;
 784     }
 785
 786     if ($new_proto != $protocol_version) {
 787         syslog("LOG_INFO", "Setting protocol level to $new_proto");
 788         $protocol_version = $new_proto;
 789     }
 790
 791     unless (defined $server->{account}) {
 792         # If we haven't logged in yet, go ahead and
 793         # return the SC status anyway, arbitrarily using the
 794         # first account in Perl string sort order to specify
 795         # the account, institution, and ILS. This supports
 796         # raw clients such as Relais that insist on sending 99 first
 797         # before 93.
 798         syslog('LOG_INFO', 'sending SC status without logging in first');
 799         my $mock_server;
 800         $mock_server->{config} = $server->{config};
 801         my $uid = (sort keys %{ $server->{config}->{accounts} })[0];
 802         _load_ils_handler($mock_server, $uid);
 803         return send_acs_status($self, $mock_server) ? SC_STATUS : '';
 804     }
 805
 806     if ($status == SC_STATUS_PAPER) {
 807         syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
 808                $server->{account}->{id}, $server->{account}->{institution});
 809     } elsif ($status == SC_STATUS_SHUTDOWN) {
 810         syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
 811                $server->{account}->{id}, $server->{account}->{institution});
 812     }
 813
 814     $server->{account}->{print_width} = $print_width;
 815
 816     return send_acs_status($self, $server) ? SC_STATUS : '';
 817 }
 818
 819 sub handle_request_acs_resend {
 820     my ($self, $server) = @_;
 821
 822     if (!$last_response) {
 823         # We haven't sent anything yet, so respond with a
 824         # REQUEST_SC_RESEND msg (p. 16)
 825         $self->write_msg(REQUEST_SC_RESEND);
 826     } elsif ((length($last_response) < 9)
 827                || substr($last_response, -9, 2) ne 'AY') {
 828         # When resending a message, we aren't supposed to include
 829         # a sequence number, even if the original had one (p. 4).
 830         # If the last message didn't have a sequence number, then
 831         # we can just send it.
 832         print("$last_response\r");
 833     } else {
 834         # Cut out the sequence number and checksum, since the old
 835         # checksum is wrong for the resent message.
 836         $self->write_msg(substr($last_response, 0, -9));
 837     }
 838     return REQUEST_ACS_RESEND;
 839 }
 840
 841 sub handle_login {
 842     my ($self, $server) = @_;
 843     my ($uid_algorithm, $pwd_algorithm, $sc_loc);
 844     my ($uid, $pwd);
 845     my $inst;
 846     my $fields;
 847     my $status = 1;             # Assume it all works
 848
 849     $fields = $self->{fields};
 850     ($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}};
 851
 852     $uid = $fields->{(FID_LOGIN_UID)};
 853     $pwd = $fields->{(FID_LOGIN_PWD)};
 854     $sc_loc = $fields->{(FID_LOCATION_CODE)};
 855
 856     if ($uid_algorithm || $pwd_algorithm) {
 857         syslog("LOG_ERR", "LOGIN: Can't cope with non-zero encryption methods: uid = $uid_algorithm, pwd = $pwd_algorithm");
 858         $status = 0;
 859     }
 860
 861     if (!exists($server->{config}->{accounts}->{$uid})) {
 862         syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'");
 863         $status = 0;
 864     } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
 865         syslog("LOG_WARNING", "MsgType::handle_login: Invalid password for login '$uid'");
 866         $status = 0;
 867     } else {
 868         if (to_bool(
 869                 $server
 870                     ->{config}
 871                     ->{institutions}
 872                     ->{ $server->{config}->{accounts}->{$uid}->{institution} }
 873                     ->{policy}
 874                     ->{client_location_code}
 875         )) {
 876             $sc_loc ||= $server->{config}->{accounts}->{$uid}->{location_code};
 877         } else {
 878             # Only use config file value
 879             $sc_loc = $server->{config}->{accounts}->{$uid}->{location_code};
 880         }
 881         _load_ils_handler($server, $uid, $sc_loc);
 882     }
 883
 884     $server->{login_complete}->($status) if $server->{login_complete};
 885
 886     $self->write_msg(LOGIN_RESP . $status);
 887
 888     return $status ? LOGIN : '';
 889 }
 890
 891 sub _load_ils_handler {
 892     my ($server, $uid, $sc_loc) = @_;
 893
 894     # Store the active account someplace handy for everybody else to find.
 895     $server->{account}     = $server->{config}->{accounts}->{$uid};
 896     my $inst               = $server->{account}->{institution};
 897     $server->{institution} = $server->{config}->{institutions}->{$inst};
 898     $server->{policy}      = $server->{institution}->{policy};
 899     $server->{account}->{location} = $sc_loc if $sc_loc;
 900     # Set the encoding for responses messages.
 901     $server->{encoding} = $server->{account}->{encoding}
 902         || $server->{institution}->{encoding}
 903         || $server->{institution}->{implementation_config}->{encoding}
 904         || 'ascii'; # Use ascii if not set.  The spec expects this.
 905     # We shouldn't be looking at the implementation config here, but
 906     # that's where the encoding lived for the longest time.  So, we
 907     # look there in the interest of backward compatibility.  That
 908     # should be officially deprecated at some point, and that check
 909     # removed.
 910
 911     syslog("LOG_INFO", "Successful login for '%s' of '%s'", $server->{account}->{id}, $inst);
 912     #
 913     # initialize connection to ILS
 914     #
 915     my $module = $server->{config}->{institutions}->{$inst}->{implementation};
 916     $module->use;
 917
 918     if ($@) {
 919         syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
 920            $server->{service}, $module, $inst);
 921         die("Failed to load ILS implementation '$module'");
 922     }
 923
 924     $server->{ils} = $module->new($server->{institution}, $server->{account});
 925
 926     if (!$server->{ils}) {
 927         syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
 928         die("Unable to connect to ILS '$inst'");
 929     }
 930 }
 931
 932 #
 933 # Build the detailed summary information for the Patron
 934 # Information Response message based on the first 'Y' that appears
 935 # in the 'summary' field of the Patron Information reqest.  The
 936 # specification says that only one 'Y' can appear in that field,
 937 # and we're going to believe it.
 938 #
 939 sub summary_info {
 940     my ($ils, $patron, $summary, $start, $end) = @_;
 941     my $resp = '';
 942     my $itemlist;
 943     my $summary_type;
 944     my ($func, $fid);
 945     #
 946     # Map from offsets in the "summary" field of the Patron Information
 947     # message to the corresponding field and handler
 948     #
 949     my @summary_map = (
 950         { func => $patron->can("hold_items"),    fid => FID_HOLD_ITEMS },
 951         { func => $patron->can("overdue_items"), fid => FID_OVERDUE_ITEMS },
 952         { func => $patron->can("charged_items"), fid => FID_CHARGED_ITEMS },
 953         { func => $patron->can("fine_items"),    fid => FID_FINE_ITEMS },
 954         { func => $patron->can("recall_items"),  fid => FID_RECALL_ITEMS },
 955         { func => $patron->can("unavail_holds"), fid => FID_UNAVAILABLE_HOLD_ITEMS },
 956     );
 957
 958
 959     if (($summary_type = index($summary, 'Y')) == -1) {
 960         # No detailed information required
 961         return '';
 962     }
 963
 964     if ($summary_type > $#summary_map || not defined $summary_map[$summary_type]->{func}) {
 965         # Huh, we don't have any code to handle the requested summary information.
 966         # Pretend nothing was asked for instead.
 967         return '';
 968     }
 969
 970     syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
 971            $summary_type, $summary_map[$summary_type]->{fid});
 972
 973     $func = $summary_map[$summary_type]->{func};
 974     $fid  = $summary_map[$summary_type]->{fid};
 975     $itemlist = &$func($patron, $start, $end);
 976
 977     syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
 978     foreach my $i (@{$itemlist}) {
 979         $resp .= add_field($fid, $i);
 980     }
 981
 982     return $resp;
 983 }
 984
 985 sub handle_patron_info {
 986     my ($self, $server) = @_;
 987     my $ils = $server->{ils};
 988     my ($lang, $trans_date, $summary) = @{$self->{fixed_fields}};
 989     my $fields = $self->{fields};
 990     my ($inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end);
 991     my ($resp, $patron, $count);
 992     $lang ||= '000'; # unspecified
 993
 994     $inst_id      = $fields->{(FID_INST_ID)};
 995     $patron_id    = $fields->{(FID_PATRON_ID)};
 996     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
 997     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
 998     $start        = $fields->{(FID_START_ITEM)};
 999     $end          = $fields->{(FID_END_ITEM)};
1000
1001     $patron = $ils->find_patron($patron_id);
1002
1003     $resp = (PATRON_INFO_RESP);
1004     if ($patron) {
1005         $resp .= patron_status_string($patron);
1006
1007         $lang = $patron->language if $patron->language;
1008         $resp .= $lang . Sip::timestamp();
1009
1010         $resp .= add_count('patron_info/hold_items',    scalar @{$patron->hold_items(undef,undef,1)   });
1011         $resp .= add_count('patron_info/overdue_items', scalar @{$patron->overdue_items(undef,undef,1)});
1012         $resp .= add_count('patron_info/charged_items', scalar @{$patron->charged_items(undef,undef,1)});
1013         $resp .= add_count('patron_info/fine_items',    scalar @{$patron->fine_items(undef,undef,1)   });
1014         $resp .= add_count('patron_info/recall_items',  scalar @{$patron->recall_items(undef,undef,1) });
1015         $resp .= add_count('patron_info/unavail_holds', scalar @{$patron->unavail_holds(undef,undef,1)});
1016
1017         $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1018
1019         # while the patron ID we got from the SC is valid, let's
1020         # use the one returned from the ILS, just in case...
1021         $resp .= add_field(FID_PATRON_ID, $patron->id);
1022
1023         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
1024
1025         # TODO: add code for the fields
1026         #    hold items limit
1027         # overdue items limit
1028         # charged items limit
1029         #           fee limit
1030
1031         $resp .= maybe_add(FID_CURRENCY,   $patron->currency  );
1032         $resp .= maybe_add(FID_FEE_AMT,    $patron->fee_amount);
1033         $resp .= maybe_add(FID_HOME_ADDR,  $patron->address   );
1034         $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
1035         $resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
1036
1037         # Extension requested by PINES. Report the home system for
1038         # the patron in the 'AQ' field. This is normally the "permanent
1039         # location" field for an ITEM, but it's not used in PATRON info.
1040         # Apparently TLC systems do this.
1041         $resp .= maybe_add(FID_HOME_LIBRARY, $patron->home_library);
1042
1043         $resp .= summary_info($ils, $patron, $summary, $start, $end);
1044
1045         $resp .= add_field(FID_VALID_PATRON, 'Y');
1046         if (defined($patron_pwd)) {
1047                 # If the patron password was provided, report on if it was right.
1048             $resp .= add_field(FID_VALID_PATRON_PWD,
1049                                sipbool($patron->check_password($patron_pwd)));
1050         }
1051
1052         # SIP 2.0 extensions used by Envisionware
1053         # Other types of terminals will ignore the fields, if
1054         # they don't recognize the codes
1055         if ($patron->can('sip_expire')) {
1056             $resp .= maybe_add(FID_PATRON_EXPIRE, $patron->sip_expire);
1057         }
1058         $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->sip_birthdate);
1059         $resp .= maybe_add(FID_PATRON_CLASS, $patron->ptype);
1060
1061         # Custom protocol extension to report patron internet privileges
1062         $resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
1063
1064         $resp .= maybe_add(FID_PATRON_INTERNAL_ID, $patron->internal_id);   # another extension
1065
1066         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
1067         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
1068
1069         # Custom ILS-defined protocol extensions
1070         if ($patron->can('extra_fields')) {
1071             my $extra_fields = $patron->extra_fields();
1072             foreach my $field (keys %$extra_fields) {
1073                 foreach my $value (@{$extra_fields->{ $field }}) {
1074                     $resp .= maybe_add($field, $value);
1075                 }
1076             }
1077         }
1078     } else {
1079         # Invalid patron ID
1080         # He has no privileges, no items associated with him,
1081         # no personal name, and is invalid (if we're using 2.00)
1082         $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
1083         $resp .= '0000' x 6;
1084
1085         $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1086         # the patron ID is invalid, but it's a required field, so
1087         # just echo it back
1088         $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
1089         $resp .= add_field(FID_PERSONAL_NAME, '');
1090
1091         if ($protocol_version >= 2) {
1092             $resp .= add_field(FID_VALID_PATRON, 'N');
1093         }
1094     }
1095
1096     $self->write_msg($resp, undef, $server->{encoding});
1097
1098     return(PATRON_INFO);
1099 }
1100
1101 sub handle_end_patron_session {
1102     my ($self, $server) = @_;
1103     my $ils = $server->{ils};
1104     my $trans_date;
1105     my $fields = $self->{fields};
1106     my $resp = END_SESSION_RESP;
1107     my ($status, $screen_msg, $print_line);
1108
1109     ($trans_date) = @{$self->{fixed_fields}};
1110
1111     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_end_patron_session");
1112
1113     ($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
1114
1115     $resp .= $status ? 'Y' : 'N';
1116     $resp .= Sip::timestamp();
1117
1118     $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1119     $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
1120
1121     $resp .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1122     $resp .= maybe_add(FID_PRINT_LINE, $print_line);
1123
1124     $self->write_msg($resp, undef, $server->{encoding});
1125
1126     return(END_PATRON_SESSION);
1127 }
1128
1129 sub handle_fee_paid {
1130     my ($self, $server) = @_;
1131     my $ils = $server->{ils};
1132     my ($trans_date, $fee_type, $pay_type, $currency) = @{$self->{fixed_fields}};
1133     my $fields = $self->{fields};
1134     my ($fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd);
1135     my ($fee_id, $trans_id);
1136     my $status;
1137     my $resp = FEE_PAID_RESP;
1138
1139     $fee_amt    = $fields->{(FID_FEE_AMT)};
1140     $inst_id    = $fields->{(FID_INST_ID)};
1141     $patron_id  = $fields->{(FID_PATRON_ID)};
1142     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1143     $fee_id     = $fields->{(FID_FEE_ID)};
1144     $trans_id   = $fields->{(FID_TRANSACTION_ID)};
1145
1146     $ils->check_inst_id($inst_id, "handle_fee_paid");
1147
1148     $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
1149                            $pay_type, $fee_id, $trans_id, $currency);
1150
1151     $resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;
1152     $resp .= add_field(FID_INST_ID, $inst_id);
1153     $resp .= add_field(FID_PATRON_ID, $patron_id);
1154     $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1155     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1156     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1157
1158     $self->write_msg($resp, undef, $server->{encoding});
1159
1160     return(FEE_PAID);
1161 }
1162
1163 sub handle_item_information {
1164     my ($self, $server) = @_;
1165     my $ils = $server->{ils};
1166     my $trans_date;
1167     my $fields = $self->{fields};
1168     my $resp = ITEM_INFO_RESP;
1169     my $item;
1170
1171     ($trans_date) = @{$self->{fixed_fields}};
1172
1173     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_item_information");
1174
1175     $item = $ils->find_item($fields->{(FID_ITEM_ID)});
1176
1177     if (!defined($item)) {
1178         # Invalid Item ID
1179         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1180         $resp .= "010101";
1181         $resp .= Sip::timestamp;
1182         # Just echo back the invalid item id
1183         $resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
1184         # title id is required, but we don't have one
1185         $resp .= add_field(FID_TITLE_ID, '');
1186     } else {
1187         # Valid Item ID, send the good stuff
1188         $resp .= $item->sip_circulation_status;
1189         $resp .= $item->sip_security_marker;
1190         $resp .= $item->sip_fee_type;
1191         $resp .= Sip::timestamp;
1192
1193         $resp .= add_field(FID_ITEM_ID,  $item->id);
1194         $resp .= add_field(FID_TITLE_ID, $item->title_id);
1195
1196         $resp .= maybe_add(FID_MEDIA_TYPE,   $item->sip_media_type);
1197         $resp .= maybe_add(FID_PERM_LOCN,    $item->permanent_location);
1198         $resp .= maybe_add(FID_CURRENT_LOCN, $item->current_location);
1199         $resp .= maybe_add(FID_ITEM_PROPS,   $item->sip_item_properties);
1200
1201         if ($item->fee) {
1202             $resp .= add_field(FID_CURRENCY, $item->fee_currency);
1203             $resp .= add_field(FID_FEE_AMT,  $item->fee);
1204         }
1205         $resp .= maybe_add(FID_OWNER,            $item->owner);
1206         $resp .= maybe_add(FID_HOLD_QUEUE_LEN,   scalar @{$item->hold_queue});
1207         $resp .= maybe_add(FID_DUE_DATE,         $item->due_date);
1208         $resp .= maybe_add(FID_RECALL_DATE,      $item->recall_date);
1209         $resp .= maybe_add(FID_HOLD_PICKUP_DATE, $item->hold_pickup_date);
1210         $resp .= maybe_add(FID_DESTINATION_LOCATION, $item->destination_loc);  # Extension for AMH sorting
1211         $resp .= maybe_add(FID_CALL_NUMBER,      $item->call_number);          # Extension for AMH sorting
1212         $resp .= maybe_add(FID_SCREEN_MSG,       $item->screen_msg);
1213         $resp .= maybe_add(FID_PRINT_LINE,       $item->print_line);
1214
1215         # Custom ILS-defined protocol extensions
1216         if ($item->can('extra_fields')) {
1217             my $extra_fields = $item->extra_fields();
1218             foreach my $field (keys %$extra_fields) {
1219                 foreach my $value (@{$extra_fields->{ $field }}) {
1220                     $resp .= maybe_add($field, $value);
1221                 }
1222             }
1223         }
1224     }
1225
1226     $self->write_msg($resp, undef, $server->{encoding});
1227
1228     return(ITEM_INFORMATION);
1229 }
1230
1231 sub handle_item_status_update {
1232     my ($self, $server) = @_;
1233     my $ils = $server->{ils};
1234     my ($trans_date, $item_id, $terminal_pwd, $item_props);
1235     my $fields = $self->{fields};
1236     my $status;
1237     my $item;
1238     my $resp = ITEM_STATUS_UPDATE_RESP;
1239
1240     ($trans_date) = @{$self->{fixed_fields}};
1241
1242     $ils->check_inst_id($fields->{(FID_INST_ID)});
1243
1244     $item_id    = $fields->{(FID_ITEM_ID)};
1245     $item_props = $fields->{(FID_ITEM_PROPS)};
1246
1247     if (!defined($item_id)) {
1248         syslog("LOG_WARNING", "handle_item_status: received message without Item ID field");
1249     } else {
1250         $item = $ils->find_item($item_id);
1251     }
1252
1253     if (!$item) {
1254         # Invalid Item ID
1255         $resp .= '0';
1256         $resp .= Sip::timestamp;
1257         $resp .= add_field(FID_ITEM_ID, $item_id);
1258     } else {
1259         # Valid Item ID
1260         $status = $item->status_update($item_props);
1261
1262         $resp .= $status->ok ? '1' : '0';
1263         $resp .= Sip::timestamp;
1264
1265         $resp .= add_field(FID_ITEM_ID,    $item->id);
1266         $resp .= add_field(FID_TITLE_ID,   $item->title_id);
1267         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1268     }
1269
1270     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1271     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1272
1273     $self->write_msg($resp, undef, $server->{encoding});
1274
1275     return(ITEM_STATUS_UPDATE);
1276 }
1277
1278 sub handle_patron_enable {
1279     my ($self, $server) = @_;
1280     my $ils    = $server->{ils};
1281     my $fields = $self->{fields};
1282     my ($trans_date, $patron_id, $terminal_pwd, $patron_pwd);
1283     my ($status, $patron);
1284     my $resp = PATRON_ENABLE_RESP;
1285
1286     ($trans_date) = @{$self->{fixed_fields}};
1287     $patron_id  = $fields->{(FID_PATRON_ID)};
1288     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1289
1290     syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
1291            $patron_id, $patron_pwd);
1292
1293     $patron = $ils->find_patron($patron_id);
1294
1295     if (!defined($patron)) {
1296         # Invalid patron ID
1297         $resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();
1298         $resp .= add_field(FID_PATRON_ID, $patron_id);
1299         $resp .= add_field(FID_PERSONAL_NAME,    '' );
1300         $resp .= add_field(FID_VALID_PATRON,     'N');
1301         $resp .= add_field(FID_VALID_PATRON_PWD, 'N');
1302     } else {
1303         # valid patron
1304         if (!defined($patron_pwd) || $patron->check_password($patron_pwd)) {
1305             # Don't enable the patron if there was an invalid password
1306             $status = $patron->enable;
1307         }
1308         $resp .= patron_status_string($patron);
1309         $resp .= $patron->language . Sip::timestamp();
1310
1311         $resp .= add_field(FID_PATRON_ID,     $patron->id);
1312         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
1313         if (defined($patron_pwd)) {
1314             $resp .= add_field(FID_VALID_PATRON_PWD,
1315                        sipbool($patron->check_password($patron_pwd)));
1316         }
1317         $resp .= add_field(FID_VALID_PATRON, 'Y');
1318         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
1319         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
1320     }
1321
1322     $resp .= add_field(FID_INST_ID, $ils->institution);
1323
1324     $self->write_msg($resp, undef, $server->{encoding});
1325
1326     return(PATRON_ENABLE);
1327 }
1328
1329 sub handle_hold {
1330     my ($self, $server) = @_;
1331     my $ils = $server->{ils};
1332     my ($hold_mode, $trans_date);
1333     my ($expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd);
1334     my ($item_id, $title_id, $fee_ack);
1335     my $fields = $self->{fields};
1336     my $status;
1337     my $resp = HOLD_RESP;
1338
1339     ($hold_mode, $trans_date) = @{$self->{fixed_fields}};
1340
1341     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_hold");
1342
1343     $patron_id   = $fields->{(FID_PATRON_ID)  };
1344     $expiry_date = $fields->{(FID_EXPIRATION) } || '';
1345     $pickup_locn = $fields->{(FID_PICKUP_LOCN)} || '';
1346     $hold_type   = $fields->{(FID_HOLD_TYPE)  } || '2'; # Any copy of title
1347     $patron_pwd  = $fields->{(FID_PATRON_PWD) };
1348     $item_id     = $fields->{(FID_ITEM_ID)    } || '';
1349     $title_id    = $fields->{(FID_TITLE_ID)   } || '';
1350     $fee_ack     = $fields->{(FID_FEE_ACK)    } || 'N';
1351
1352     if ($hold_mode eq '+') {
1353         $status = $ils->add_hold($patron_id, $patron_pwd,
1354                                  $item_id, $title_id,
1355                                  $expiry_date, $pickup_locn, $hold_type,
1356                                  $fee_ack);
1357     } elsif ($hold_mode eq '-') {
1358         $status = $ils->cancel_hold($patron_id, $patron_pwd,
1359                                     $item_id, $title_id);
1360     } elsif ($hold_mode eq '*') {
1361         $status = $ils->alter_hold($patron_id, $patron_pwd,
1362                                    $item_id, $title_id,
1363                                    $expiry_date, $pickup_locn, $hold_type,
1364                                    $fee_ack);
1365     } else {
1366         syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
1367                $hold_mode, $server->{account}->{id});
1368         $status = $ils->Transaction::Hold;
1369         $status->screen_msg("System error. Please contact library status");
1370     }
1371
1372     $resp .= $status->ok;
1373     $resp .= sipbool($status->item && $status->item->available($patron_id));
1374     $resp .= Sip::timestamp;
1375
1376     if ($status->ok) {
1377         $resp .= add_field(FID_PATRON_ID, $status->patron->id);
1378
1379         if ($status->expiration_date) {
1380             $resp .= maybe_add(FID_EXPIRATION,
1381                                Sip::timestamp($status->expiration_date));
1382         }
1383         $resp .= maybe_add(FID_QUEUE_POS,   $status->queue_position);
1384         $resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
1385         $resp .= maybe_add(FID_ITEM_ID,     $status->item->id);
1386         $resp .= maybe_add(FID_TITLE_ID,    $status->item->title_id);
1387     } else {
1388         # Not ok.  still need required fields
1389         $resp .= add_field(FID_PATRON_ID, $patron_id);
1390     }
1391
1392     $resp .= add_field(FID_INST_ID, $ils->institution);
1393     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1394     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1395
1396     $self->write_msg($resp, undef, $server->{encoding});
1397
1398     return(HOLD);
1399 }
1400
1401 sub handle_renew {
1402     my ($self, $server) = @_;
1403     my $ils = $server->{ils};
1404     my ($third_party, $no_block, $trans_date, $nb_due_date);
1405     my ($patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack);
1406     my $fields = $self->{fields};
1407     my $status;
1408     my ($patron, $item);
1409     my $resp = RENEW_RESP;
1410
1411     ($third_party, $no_block, $trans_date, $nb_due_date) =
1412         @{$self->{fixed_fields}};
1413
1414     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
1415
1416     if ($no_block eq 'Y') {
1417         syslog("LOG_WARNING",
1418                "handle_renew: recieved 'no block' renewal from terminal '%s'",
1419                $server->{account}->{id});
1420     }
1421
1422     $patron_id  = $fields->{(FID_PATRON_ID)};
1423     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1424     $item_id    = $fields->{(FID_ITEM_ID)};
1425     $title_id   = $fields->{(FID_TITLE_ID)};
1426     $item_props = $fields->{(FID_ITEM_PROPS)};
1427     $fee_ack    = $fields->{(FID_FEE_ACK)};
1428
1429     $status = $ils->renew($patron_id, $patron_pwd, $item_id, $title_id,
1430                           $no_block, $nb_due_date, $third_party,
1431                           $item_props, $fee_ack);
1432
1433     $patron = $status->patron;
1434     $item   = $status->item;
1435
1436     if ($status->ok) {
1437         $resp .= '1';
1438         $resp .= $status->renewal_ok ? 'Y' : 'N';
1439         if ($ils->supports('magnetic media')) {
1440             $resp .= sipbool($item->magnetic);
1441         } else {
1442             $resp .= 'U';
1443         }
1444     $resp .= sipbool($status->desensitize);
1445     $resp .= Sip::timestamp;
1446     $resp .= add_field(FID_PATRON_ID, $patron->id);
1447     $resp .= add_field(FID_ITEM_ID,   $item->id);
1448     $resp .= add_field(FID_TITLE_ID,  $item->title_id);
1449     $resp .= add_field(FID_DUE_DATE,  $item->due_date);
1450     if ($ils->supports('security inhibit')) {
1451         $resp .= add_field(FID_SECURITY_INHIBIT, $status->security_inhibit);
1452     }
1453         $resp .= add_field(FID_MEDIA_TYPE, $item->sip_media_type);
1454         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1455     } else {
1456         # renew failed for some reason
1457         # not OK, renewal not OK, Unknown media type (why bother checking?)
1458         $resp .= '0NUN';
1459         $resp .= Sip::timestamp;
1460         # If we found the patron or the item, the return the ILS
1461         # information, otherwise echo back the infomation we received
1462         # from the terminal
1463     $resp .= add_field(FID_PATRON_ID, $patron ? $patron->id     : $patron_id);
1464     $resp .= add_field(FID_ITEM_ID,   $item   ? $item->id       : $item_id  );
1465     $resp .= add_field(FID_TITLE_ID,  $item   ? $item->title_id : $title_id );
1466     $resp .= add_field(FID_DUE_DATE, '');
1467     }
1468
1469     if ($status->fee_amount) {
1470         $resp .= add_field(FID_FEE_AMT,        $status->fee_amount);
1471         $resp .= maybe_add(FID_CURRENCY,       $status->sip_currency);
1472         $resp .= maybe_add(FID_FEE_TYPE,       $status->sip_fee_type);
1473         $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1474     }
1475
1476     $resp .= add_field(FID_INST_ID, $ils->institution);
1477     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1478     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1479
1480     $self->write_msg($resp, undef, $server->{encoding});
1481
1482     return(RENEW);
1483 }
1484
1485 sub handle_renew_all {
1486     my ($self, $server) = @_;
1487     my $ils = $server->{ils};
1488     my ($trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack);
1489     my $fields = $self->{fields};
1490     my $resp = RENEW_ALL_RESP;
1491     my $status;
1492     my (@renewed, @unrenewed);
1493
1494     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew_all");
1495
1496     ($trans_date) = @{$self->{fixed_fields}};
1497
1498     $patron_id    = $fields->{(FID_PATRON_ID)};
1499     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
1500     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
1501     $fee_ack      = $fields->{(FID_FEE_ACK)};
1502
1503     $status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack);
1504
1505     $resp .= $status->ok ? '1' : '0';
1506
1507     if (!$status->ok) {
1508         $resp .= add_count("renew_all/renewed_count", 0);
1509         $resp .= add_count("renew_all/unrenewed_count", 0);
1510         @renewed = [];
1511         @unrenewed = [];
1512     } else {
1513         @renewed = @{$status->renewed};
1514         @unrenewed = @{$status->unrenewed};
1515         $resp .= add_count("renew_all/renewed_count", scalar @renewed);
1516         $resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
1517     }
1518
1519     $resp .= Sip::timestamp;
1520     $resp .= add_field(FID_INST_ID, $ils->institution);
1521
1522     $resp .= join('', map(add_field(FID_RENEWED_ITEMS, $_), @renewed));
1523     $resp .= join('', map(add_field(FID_UNRENEWED_ITEMS, $_), @unrenewed));
1524
1525     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1526     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1527
1528     $self->write_msg($resp, undef, $server->{encoding});
1529
1530     return(RENEW_ALL);
1531 }
1532
1533 #
1534 # send_acs_status($self, $server)
1535 #
1536 # Send an ACS Status message, which is contains lots of little fields
1537 # of information gleaned from all sorts of places.
1538 #
1539
1540 my @message_type_names = (
1541                           "patron status request",
1542                           "checkout",
1543                           "checkin",
1544                           "block patron",
1545                           "acs status",
1546                           "request sc/acs resend",
1547                           "login",
1548                           "patron information",
1549                           "end patron session",
1550                           "fee paid",
1551                           "item information",
1552                           "item status update",
1553                           "patron enable",
1554                           "hold",
1555                           "renew",
1556                           "renew all",
1557                          );
1558
1559 sub send_acs_status {
1560     my ($self, $server, $screen_msg, $print_line) = @_;
1561     my $msg = ACS_STATUS;
1562     my $account = $server->{account};
1563     my $policy  = $server->{policy};
1564     my $ils     = $server->{ils};
1565     my ($online_status, $checkin_ok, $checkout_ok, $ACS_renewal_policy);
1566     my ($status_update_ok, $offline_ok, $timeout, $retries);
1567
1568     $online_status = 'Y';
1569     $checkout_ok        = sipbool($ils->checkout_ok);
1570     $checkin_ok         = sipbool($ils->checkin_ok);
1571     $ACS_renewal_policy = sipbool($policy->{renewal});
1572     $status_update_ok   = sipbool($ils->status_update_ok);
1573     $offline_ok         = sipbool($ils->offline_ok);
1574     $timeout = sprintf("%03d", $policy->{timeout});
1575     $retries = sprintf("%03d", $policy->{retries});
1576
1577     if (length($timeout) != 3) {
1578         syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", $timeout);
1579         $timeout = '000';
1580     }
1581
1582     if (length($retries) != 3) {
1583         syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries);
1584         $retries = '000';
1585     }
1586
1587     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1588     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1589     $msg .= Sip::timestamp();
1590
1591     if ($protocol_version == 1) {
1592         $msg .= '1.00';
1593     } elsif ($protocol_version == 2) {
1594         $msg .= '2.00';
1595     } else {
1596         syslog("LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version);
1597         $msg .= '1.00';
1598     }
1599
1600     # Institution ID
1601     $msg .= add_field(FID_INST_ID, $account->{institution});
1602
1603     if ($protocol_version >= 2) {
1604     # Supported messages: we do it all
1605     my $supported_msgs = '';
1606
1607     foreach my $msg_name (@message_type_names) {
1608         if ( $msg_name eq 'request sc/acs resend' ) {
1609             $supported_msgs .= Sip::sipbool(1);
1610         } else {
1611             $supported_msgs .= Sip::sipbool( $ils->supports($msg_name) );
1612         }
1613     }
1614     if (length($supported_msgs) < 16) {
1615         syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
1616     }
1617         $msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
1618     }
1619
1620     $msg .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1621
1622     if (defined($account->{print_width}) && defined($print_line)
1623              && $account->{print_width}  <  length( $print_line)) {
1624         syslog("LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line);
1625         $print_line = substr($print_line, 0, $account->{print_width});
1626     }
1627
1628     $msg .= maybe_add(FID_PRINT_LINE, $print_line);
1629
1630     # Do we want to tell the terminal its location?
1631
1632     $self->write_msg($msg, undef, $server->{encoding});
1633     return 1;
1634 }
1635
1636 #
1637 # patron_status_string: create the 14-char patron status
1638 # string for the Patron Status message
1639 #
1640 sub patron_status_string {
1641     my $patron = shift;
1642     syslog("LOG_DEBUG", "patron_status_string for %s charge_ok: %s", $patron->id, $patron->charge_ok);
1643     my $patron_status = sprintf('%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1644         denied($patron->charge_ok),
1645         denied($patron->renew_ok),
1646         denied($patron->recall_ok),
1647         denied($patron->hold_ok),
1648         boolspace($patron->card_lost),
1649         boolspace($patron->too_many_charged),
1650         boolspace($patron->too_many_overdue),
1651         boolspace($patron->too_many_renewal),
1652         boolspace($patron->too_many_claim_return),
1653         boolspace($patron->too_many_lost),
1654         boolspace($patron->excessive_fines),
1655         boolspace($patron->excessive_fees),
1656         boolspace($patron->recall_overdue),
1657         boolspace($patron->too_many_billed)
1658     );
1659     return $patron_status;
1660 }
1661
1662 1;