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