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         }
 712     }
 713
 714     $resp .= maybe_add(FID_ALERT_TYPE, $status->alert_type) if $status->alert;
 715     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 716     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 717
 718     $self->write_msg($resp, undef, $server->{encoding});
 719
 720     return(CHECKIN);
 721 }
 722
 723 sub handle_block_patron {
 724     my ($self, $server) = @_;
 725     my $ils     = $server->{ils};
 726     my ($card_retained, $trans_date);
 727     my ($inst_id, $blocked_card_msg, $patron_id, $terminal_pwd);
 728     my $fields;
 729     my $resp;
 730     my $patron;
 731
 732     ($card_retained, $trans_date) = @{$self->{fixed_fields}};
 733     $fields = $self->{fields};
 734     $inst_id          = $fields->{(FID_INST_ID)};
 735     $blocked_card_msg = $fields->{(FID_BLOCKED_CARD_MSG)};
 736     $patron_id        = $fields->{(FID_PATRON_ID)};
 737     $terminal_pwd     = $fields->{(FID_TERMINAL_PWD)};
 738
 739     # Terminal passwords are different from account login
 740     # passwords, but I have no idea what to do with them.  So,
 741     # I'll just ignore them for now.
 742
 743     $ils->check_inst_id($inst_id, "block_patron");
 744
 745     $patron = $ils->find_patron($patron_id);
 746
 747     # The correct response for a "Block Patron" message is a
 748     # "Patron Status Response", so use that handler to generate
 749     # the message, but then return the correct code from here.
 750     #
 751     # Normally, the language is provided by the "Patron Status"
 752     # fixed field, but since we're not responding to one of those
 753     # we'll just say, "Unspecified", as per the spec.  Let the
 754     # terminal default to something that, one hopes, will be
 755     # intelligible
 756     my $language = $patron ? $patron->language : '000';
 757     if ($patron) {
 758         # Valid patron id
 759         $patron->block($card_retained, $blocked_card_msg);
 760     }
 761
 762     $resp = build_patron_status($patron, $language, $fields, $server);
 763
 764     $self->write_msg($resp, undef, $server->{encoding});
 765     return(BLOCK_PATRON);
 766 }
 767
 768 sub handle_sc_status {
 769     my ($self, $server) = @_;
 770     my ($status, $print_width, $sc_protocol_version, $new_proto);
 771
 772     ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}};
 773
 774     if ($sc_protocol_version =~ /^1\./) {
 775         $new_proto = 1;
 776     } elsif ($sc_protocol_version =~ /^2\./) {
 777         $new_proto = 2;
 778     } else {
 779         syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
 780         $new_proto = 1;
 781     }
 782
 783     if ($new_proto != $protocol_version) {
 784         syslog("LOG_INFO", "Setting protocol level to $new_proto");
 785         $protocol_version = $new_proto;
 786     }
 787
 788     unless (defined $server->{account}) {
 789         # If we haven't logged in yet, go ahead and
 790         # return the SC status anyway, arbitrarily using the
 791         # first account in Perl string sort order to specify
 792         # the account, institution, and ILS. This supports
 793         # raw clients such as Relais that insist on sending 99 first
 794         # before 93.
 795         syslog('LOG_INFO', 'sending SC status without logging in first');
 796         my $mock_server;
 797         $mock_server->{config} = $server->{config};
 798         my $uid = (sort keys %{ $server->{config}->{accounts} })[0];
 799         _load_ils_handler($mock_server, $uid);
 800         return send_acs_status($self, $mock_server) ? SC_STATUS : '';
 801     }
 802
 803     if ($status == SC_STATUS_PAPER) {
 804         syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
 805                $server->{account}->{id}, $server->{account}->{institution});
 806     } elsif ($status == SC_STATUS_SHUTDOWN) {
 807         syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
 808                $server->{account}->{id}, $server->{account}->{institution});
 809     }
 810
 811     $server->{account}->{print_width} = $print_width;
 812
 813     return send_acs_status($self, $server) ? SC_STATUS : '';
 814 }
 815
 816 sub handle_request_acs_resend {
 817     my ($self, $server) = @_;
 818
 819     if (!$last_response) {
 820         # We haven't sent anything yet, so respond with a
 821         # REQUEST_SC_RESEND msg (p. 16)
 822         $self->write_msg(REQUEST_SC_RESEND);
 823     } elsif ((length($last_response) < 9)
 824                || substr($last_response, -9, 2) ne 'AY') {
 825         # When resending a message, we aren't supposed to include
 826         # a sequence number, even if the original had one (p. 4).
 827         # If the last message didn't have a sequence number, then
 828         # we can just send it.
 829         print("$last_response\r");
 830     } else {
 831         # Cut out the sequence number and checksum, since the old
 832         # checksum is wrong for the resent message.
 833         $self->write_msg(substr($last_response, 0, -9));
 834     }
 835     return REQUEST_ACS_RESEND;
 836 }
 837
 838 sub handle_login {
 839     my ($self, $server) = @_;
 840     my ($uid_algorithm, $pwd_algorithm, $sc_loc);
 841     my ($uid, $pwd);
 842     my $inst;
 843     my $fields;
 844     my $status = 1;             # Assume it all works
 845
 846     $fields = $self->{fields};
 847     ($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}};
 848
 849     $uid = $fields->{(FID_LOGIN_UID)};
 850     $pwd = $fields->{(FID_LOGIN_PWD)};
 851     $sc_loc = $fields->{(FID_LOCATION_CODE)};
 852
 853     if ($uid_algorithm || $pwd_algorithm) {
 854         syslog("LOG_ERR", "LOGIN: Can't cope with non-zero encryption methods: uid = $uid_algorithm, pwd = $pwd_algorithm");
 855         $status = 0;
 856     }
 857
 858     if (!exists($server->{config}->{accounts}->{$uid})) {
 859         syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'");
 860         $status = 0;
 861     } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
 862         syslog("LOG_WARNING", "MsgType::handle_login: Invalid password for login '$uid'");
 863         $status = 0;
 864     } else {
 865         if (to_bool(
 866                 $server
 867                     ->{config}
 868                     ->{institutions}
 869                     ->{ $server->{config}->{accounts}->{$uid}->{institution} }
 870                     ->{policy}
 871                     ->{client_location_code}
 872         )) {
 873             $sc_loc ||= $server->{config}->{accounts}->{$uid}->{location_code};
 874         } else {
 875             # Only use config file value
 876             $sc_loc = $server->{config}->{accounts}->{$uid}->{location_code};
 877         }
 878         _load_ils_handler($server, $uid, $sc_loc);
 879     }
 880
 881     $server->{login_complete}->($status) if $server->{login_complete};
 882
 883     $self->write_msg(LOGIN_RESP . $status);
 884
 885     return $status ? LOGIN : '';
 886 }
 887
 888 sub _load_ils_handler {
 889     my ($server, $uid, $sc_loc) = @_;
 890
 891     # Store the active account someplace handy for everybody else to find.
 892     $server->{account}     = $server->{config}->{accounts}->{$uid};
 893     my $inst               = $server->{account}->{institution};
 894     $server->{institution} = $server->{config}->{institutions}->{$inst};
 895     $server->{policy}      = $server->{institution}->{policy};
 896     $server->{account}->{location} = $sc_loc if $sc_loc;
 897     # Set the encoding for responses messages.
 898     $server->{encoding} = $server->{account}->{encoding}
 899         || $server->{institution}->{encoding}
 900         || $server->{institution}->{implementation_config}->{encoding}
 901         || 'ascii'; # Use ascii if not set.  The spec expects this.
 902     # We shouldn't be looking at the implementation config here, but
 903     # that's where the encoding lived for the longest time.  So, we
 904     # look there in the interest of backward compatibility.  That
 905     # should be officially deprecated at some point, and that check
 906     # removed.
 907
 908     syslog("LOG_INFO", "Successful login for '%s' of '%s'", $server->{account}->{id}, $inst);
 909     #
 910     # initialize connection to ILS
 911     #
 912     my $module = $server->{config}->{institutions}->{$inst}->{implementation};
 913     $module->use;
 914
 915     if ($@) {
 916         syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
 917            $server->{service}, $module, $inst);
 918         die("Failed to load ILS implementation '$module'");
 919     }
 920
 921     $server->{ils} = $module->new($server->{institution}, $server->{account});
 922
 923     if (!$server->{ils}) {
 924         syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
 925         die("Unable to connect to ILS '$inst'");
 926     }
 927 }
 928
 929 #
 930 # Build the detailed summary information for the Patron
 931 # Information Response message based on the first 'Y' that appears
 932 # in the 'summary' field of the Patron Information reqest.  The
 933 # specification says that only one 'Y' can appear in that field,
 934 # and we're going to believe it.
 935 #
 936 sub summary_info {
 937     my ($ils, $patron, $summary, $start, $end) = @_;
 938     my $resp = '';
 939     my $itemlist;
 940     my $summary_type;
 941     my ($func, $fid);
 942     #
 943     # Map from offsets in the "summary" field of the Patron Information
 944     # message to the corresponding field and handler
 945     #
 946     my @summary_map = (
 947         { func => $patron->can("hold_items"),    fid => FID_HOLD_ITEMS },
 948         { func => $patron->can("overdue_items"), fid => FID_OVERDUE_ITEMS },
 949         { func => $patron->can("charged_items"), fid => FID_CHARGED_ITEMS },
 950         { func => $patron->can("fine_items"),    fid => FID_FINE_ITEMS },
 951         { func => $patron->can("recall_items"),  fid => FID_RECALL_ITEMS },
 952         { func => $patron->can("unavail_holds"), fid => FID_UNAVAILABLE_HOLD_ITEMS },
 953     );
 954
 955
 956     if (($summary_type = index($summary, 'Y')) == -1) {
 957         # No detailed information required
 958         return '';
 959     }
 960
 961     if ($summary_type > $#summary_map || not defined $summary_map[$summary_type]->{func}) {
 962         # Huh, we don't have any code to handle the requested summary information.
 963         # Pretend nothing was asked for instead.
 964         return '';
 965     }
 966
 967     syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
 968            $summary_type, $summary_map[$summary_type]->{fid});
 969
 970     $func = $summary_map[$summary_type]->{func};
 971     $fid  = $summary_map[$summary_type]->{fid};
 972     $itemlist = &$func($patron, $start, $end);
 973
 974     syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
 975     foreach my $i (@{$itemlist}) {
 976         $resp .= add_field($fid, $i);
 977     }
 978
 979     return $resp;
 980 }
 981
 982 sub handle_patron_info {
 983     my ($self, $server) = @_;
 984     my $ils = $server->{ils};
 985     my ($lang, $trans_date, $summary) = @{$self->{fixed_fields}};
 986     my $fields = $self->{fields};
 987     my ($inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end);
 988     my ($resp, $patron, $count);
 989     $lang ||= '000'; # unspecified
 990
 991     $inst_id      = $fields->{(FID_INST_ID)};
 992     $patron_id    = $fields->{(FID_PATRON_ID)};
 993     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
 994     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
 995     $start        = $fields->{(FID_START_ITEM)};
 996     $end          = $fields->{(FID_END_ITEM)};
 997
 998     $patron = $ils->find_patron($patron_id);
 999
1000     $resp = (PATRON_INFO_RESP);
1001     if ($patron) {
1002         $resp .= patron_status_string($patron);
1003
1004         $lang = $patron->language if $patron->language;
1005         $resp .= $lang . Sip::timestamp();
1006
1007         $resp .= add_count('patron_info/hold_items',    scalar @{$patron->hold_items(undef,undef,1)   });
1008         $resp .= add_count('patron_info/overdue_items', scalar @{$patron->overdue_items(undef,undef,1)});
1009         $resp .= add_count('patron_info/charged_items', scalar @{$patron->charged_items(undef,undef,1)});
1010         $resp .= add_count('patron_info/fine_items',    scalar @{$patron->fine_items(undef,undef,1)   });
1011         $resp .= add_count('patron_info/recall_items',  scalar @{$patron->recall_items(undef,undef,1) });
1012         $resp .= add_count('patron_info/unavail_holds', scalar @{$patron->unavail_holds(undef,undef,1)});
1013
1014         $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1015
1016         # while the patron ID we got from the SC is valid, let's
1017         # use the one returned from the ILS, just in case...
1018         $resp .= add_field(FID_PATRON_ID, $patron->id);
1019
1020         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
1021
1022         # TODO: add code for the fields
1023         #    hold items limit
1024         # overdue items limit
1025         # charged items limit
1026         #           fee limit
1027
1028         $resp .= maybe_add(FID_CURRENCY,   $patron->currency  );
1029         $resp .= maybe_add(FID_FEE_AMT,    $patron->fee_amount);
1030         $resp .= maybe_add(FID_HOME_ADDR,  $patron->address   );
1031         $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
1032         $resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
1033
1034         # Extension requested by PINES. Report the home system for
1035         # the patron in the 'AQ' field. This is normally the "permanent
1036         # location" field for an ITEM, but it's not used in PATRON info.
1037         # Apparently TLC systems do this.
1038         $resp .= maybe_add(FID_HOME_LIBRARY, $patron->home_library);
1039
1040         $resp .= summary_info($ils, $patron, $summary, $start, $end);
1041
1042         $resp .= add_field(FID_VALID_PATRON, 'Y');
1043         if (defined($patron_pwd)) {
1044                 # If the patron password was provided, report on if it was right.
1045             $resp .= add_field(FID_VALID_PATRON_PWD,
1046                                sipbool($patron->check_password($patron_pwd)));
1047         }
1048
1049         # SIP 2.0 extensions used by Envisionware
1050         # Other types of terminals will ignore the fields, if
1051         # they don't recognize the codes
1052         if ($patron->can('sip_expire')) {
1053             $resp .= maybe_add(FID_PATRON_EXPIRE, $patron->sip_expire);
1054         }
1055         $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->sip_birthdate);
1056         $resp .= maybe_add(FID_PATRON_CLASS, $patron->ptype);
1057
1058         # Custom protocol extension to report patron internet privileges
1059         $resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
1060
1061         $resp .= maybe_add(FID_PATRON_INTERNAL_ID, $patron->internal_id);   # another extension
1062
1063         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
1064         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
1065
1066         # Custom ILS-defined protocol extensions
1067         if ($patron->can('extra_fields')) {
1068             my $extra_fields = $patron->extra_fields();
1069             foreach my $field (keys %$extra_fields) {
1070                 foreach my $value (@{$extra_fields->{ $field }}) {
1071                     $resp .= maybe_add($field, $value);
1072                 }
1073             }
1074         }
1075     } else {
1076         # Invalid patron ID
1077         # He has no privileges, no items associated with him,
1078         # no personal name, and is invalid (if we're using 2.00)
1079         $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
1080         $resp .= '0000' x 6;
1081
1082         $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1083         # the patron ID is invalid, but it's a required field, so
1084         # just echo it back
1085         $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
1086         $resp .= add_field(FID_PERSONAL_NAME, '');
1087
1088         if ($protocol_version >= 2) {
1089             $resp .= add_field(FID_VALID_PATRON, 'N');
1090         }
1091     }
1092
1093     $self->write_msg($resp, undef, $server->{encoding});
1094
1095     return(PATRON_INFO);
1096 }
1097
1098 sub handle_end_patron_session {
1099     my ($self, $server) = @_;
1100     my $ils = $server->{ils};
1101     my $trans_date;
1102     my $fields = $self->{fields};
1103     my $resp = END_SESSION_RESP;
1104     my ($status, $screen_msg, $print_line);
1105
1106     ($trans_date) = @{$self->{fixed_fields}};
1107
1108     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_end_patron_session");
1109
1110     ($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
1111
1112     $resp .= $status ? 'Y' : 'N';
1113     $resp .= Sip::timestamp();
1114
1115     $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1116     $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
1117
1118     $resp .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1119     $resp .= maybe_add(FID_PRINT_LINE, $print_line);
1120
1121     $self->write_msg($resp, undef, $server->{encoding});
1122
1123     return(END_PATRON_SESSION);
1124 }
1125
1126 sub handle_fee_paid {
1127     my ($self, $server) = @_;
1128     my $ils = $server->{ils};
1129     my ($trans_date, $fee_type, $pay_type, $currency) = @{$self->{fixed_fields}};
1130     my $fields = $self->{fields};
1131     my ($fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd);
1132     my ($fee_id, $trans_id);
1133     my $status;
1134     my $resp = FEE_PAID_RESP;
1135
1136     $fee_amt    = $fields->{(FID_FEE_AMT)};
1137     $inst_id    = $fields->{(FID_INST_ID)};
1138     $patron_id  = $fields->{(FID_PATRON_ID)};
1139     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1140     $fee_id     = $fields->{(FID_FEE_ID)};
1141     $trans_id   = $fields->{(FID_TRANSACTION_ID)};
1142
1143     $ils->check_inst_id($inst_id, "handle_fee_paid");
1144
1145     $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
1146                            $pay_type, $fee_id, $trans_id, $currency);
1147
1148     $resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;
1149     $resp .= add_field(FID_INST_ID, $inst_id);
1150     $resp .= add_field(FID_PATRON_ID, $patron_id);
1151     $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1152     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1153     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1154
1155     $self->write_msg($resp, undef, $server->{encoding});
1156
1157     return(FEE_PAID);
1158 }
1159
1160 sub handle_item_information {
1161     my ($self, $server) = @_;
1162     my $ils = $server->{ils};
1163     my $trans_date;
1164     my $fields = $self->{fields};
1165     my $resp = ITEM_INFO_RESP;
1166     my $item;
1167
1168     ($trans_date) = @{$self->{fixed_fields}};
1169
1170     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_item_information");
1171
1172     $item = $ils->find_item($fields->{(FID_ITEM_ID)});
1173
1174     if (!defined($item)) {
1175         # Invalid Item ID
1176         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1177         $resp .= "010101";
1178         $resp .= Sip::timestamp;
1179         # Just echo back the invalid item id
1180         $resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
1181         # title id is required, but we don't have one
1182         $resp .= add_field(FID_TITLE_ID, '');
1183     } else {
1184         # Valid Item ID, send the good stuff
1185         $resp .= $item->sip_circulation_status;
1186         $resp .= $item->sip_security_marker;
1187         $resp .= $item->sip_fee_type;
1188         $resp .= Sip::timestamp;
1189
1190         $resp .= add_field(FID_ITEM_ID,  $item->id);
1191         $resp .= add_field(FID_TITLE_ID, $item->title_id);
1192
1193         $resp .= maybe_add(FID_MEDIA_TYPE,   $item->sip_media_type);
1194         $resp .= maybe_add(FID_PERM_LOCN,    $item->permanent_location);
1195         $resp .= maybe_add(FID_CURRENT_LOCN, $item->current_location);
1196         $resp .= maybe_add(FID_ITEM_PROPS,   $item->sip_item_properties);
1197
1198         if ($item->fee) {
1199             $resp .= add_field(FID_CURRENCY, $item->fee_currency);
1200             $resp .= add_field(FID_FEE_AMT,  $item->fee);
1201         }
1202         $resp .= maybe_add(FID_OWNER,            $item->owner);
1203         $resp .= maybe_add(FID_HOLD_QUEUE_LEN,   scalar @{$item->hold_queue});
1204         $resp .= maybe_add(FID_DUE_DATE,         $item->due_date);
1205         $resp .= maybe_add(FID_RECALL_DATE,      $item->recall_date);
1206         $resp .= maybe_add(FID_HOLD_PICKUP_DATE, $item->hold_pickup_date);
1207         $resp .= maybe_add(FID_DESTINATION_LOCATION, $item->destination_loc);  # Extension for AMH sorting
1208         $resp .= maybe_add(FID_CALL_NUMBER,      $item->call_number);          # Extension for AMH sorting
1209         $resp .= maybe_add(FID_SCREEN_MSG,       $item->screen_msg);
1210         $resp .= maybe_add(FID_PRINT_LINE,       $item->print_line);
1211
1212         # Custom ILS-defined protocol extensions
1213         if ($item->can('extra_fields')) {
1214             my $extra_fields = $item->extra_fields();
1215             foreach my $field (keys %$extra_fields) {
1216                 foreach my $value (@{$extra_fields->{ $field }}) {
1217                     $resp .= maybe_add($field, $value);
1218                 }
1219             }
1220         }
1221     }
1222
1223     $self->write_msg($resp, undef, $server->{encoding});
1224
1225     return(ITEM_INFORMATION);
1226 }
1227
1228 sub handle_item_status_update {
1229     my ($self, $server) = @_;
1230     my $ils = $server->{ils};
1231     my ($trans_date, $item_id, $terminal_pwd, $item_props);
1232     my $fields = $self->{fields};
1233     my $status;
1234     my $item;
1235     my $resp = ITEM_STATUS_UPDATE_RESP;
1236
1237     ($trans_date) = @{$self->{fixed_fields}};
1238
1239     $ils->check_inst_id($fields->{(FID_INST_ID)});
1240
1241     $item_id    = $fields->{(FID_ITEM_ID)};
1242     $item_props = $fields->{(FID_ITEM_PROPS)};
1243
1244     if (!defined($item_id)) {
1245         syslog("LOG_WARNING", "handle_item_status: received message without Item ID field");
1246     } else {
1247         $item = $ils->find_item($item_id);
1248     }
1249
1250     if (!$item) {
1251         # Invalid Item ID
1252         $resp .= '0';
1253         $resp .= Sip::timestamp;
1254         $resp .= add_field(FID_ITEM_ID, $item_id);
1255     } else {
1256         # Valid Item ID
1257         $status = $item->status_update($item_props);
1258
1259         $resp .= $status->ok ? '1' : '0';
1260         $resp .= Sip::timestamp;
1261
1262         $resp .= add_field(FID_ITEM_ID,    $item->id);
1263         $resp .= add_field(FID_TITLE_ID,   $item->title_id);
1264         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1265     }
1266
1267     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1268     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1269
1270     $self->write_msg($resp, undef, $server->{encoding});
1271
1272     return(ITEM_STATUS_UPDATE);
1273 }
1274
1275 sub handle_patron_enable {
1276     my ($self, $server) = @_;
1277     my $ils    = $server->{ils};
1278     my $fields = $self->{fields};
1279     my ($trans_date, $patron_id, $terminal_pwd, $patron_pwd);
1280     my ($status, $patron);
1281     my $resp = PATRON_ENABLE_RESP;
1282
1283     ($trans_date) = @{$self->{fixed_fields}};
1284     $patron_id  = $fields->{(FID_PATRON_ID)};
1285     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1286
1287     syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
1288            $patron_id, $patron_pwd);
1289
1290     $patron = $ils->find_patron($patron_id);
1291
1292     if (!defined($patron)) {
1293         # Invalid patron ID
1294         $resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();
1295         $resp .= add_field(FID_PATRON_ID, $patron_id);
1296         $resp .= add_field(FID_PERSONAL_NAME,    '' );
1297         $resp .= add_field(FID_VALID_PATRON,     'N');
1298         $resp .= add_field(FID_VALID_PATRON_PWD, 'N');
1299     } else {
1300         # valid patron
1301         if (!defined($patron_pwd) || $patron->check_password($patron_pwd)) {
1302             # Don't enable the patron if there was an invalid password
1303             $status = $patron->enable;
1304         }
1305         $resp .= patron_status_string($patron);
1306         $resp .= $patron->language . Sip::timestamp();
1307
1308         $resp .= add_field(FID_PATRON_ID,     $patron->id);
1309         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
1310         if (defined($patron_pwd)) {
1311             $resp .= add_field(FID_VALID_PATRON_PWD,
1312                        sipbool($patron->check_password($patron_pwd)));
1313         }
1314         $resp .= add_field(FID_VALID_PATRON, 'Y');
1315         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
1316         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
1317     }
1318
1319     $resp .= add_field(FID_INST_ID, $ils->institution);
1320
1321     $self->write_msg($resp, undef, $server->{encoding});
1322
1323     return(PATRON_ENABLE);
1324 }
1325
1326 sub handle_hold {
1327     my ($self, $server) = @_;
1328     my $ils = $server->{ils};
1329     my ($hold_mode, $trans_date);
1330     my ($expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd);
1331     my ($item_id, $title_id, $fee_ack);
1332     my $fields = $self->{fields};
1333     my $status;
1334     my $resp = HOLD_RESP;
1335
1336     ($hold_mode, $trans_date) = @{$self->{fixed_fields}};
1337
1338     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_hold");
1339
1340     $patron_id   = $fields->{(FID_PATRON_ID)  };
1341     $expiry_date = $fields->{(FID_EXPIRATION) } || '';
1342     $pickup_locn = $fields->{(FID_PICKUP_LOCN)} || '';
1343     $hold_type   = $fields->{(FID_HOLD_TYPE)  } || '2'; # Any copy of title
1344     $patron_pwd  = $fields->{(FID_PATRON_PWD) };
1345     $item_id     = $fields->{(FID_ITEM_ID)    } || '';
1346     $title_id    = $fields->{(FID_TITLE_ID)   } || '';
1347     $fee_ack     = $fields->{(FID_FEE_ACK)    } || 'N';
1348
1349     if ($hold_mode eq '+') {
1350         $status = $ils->add_hold($patron_id, $patron_pwd,
1351                                  $item_id, $title_id,
1352                                  $expiry_date, $pickup_locn, $hold_type,
1353                                  $fee_ack);
1354     } elsif ($hold_mode eq '-') {
1355         $status = $ils->cancel_hold($patron_id, $patron_pwd,
1356                                     $item_id, $title_id);
1357     } elsif ($hold_mode eq '*') {
1358         $status = $ils->alter_hold($patron_id, $patron_pwd,
1359                                    $item_id, $title_id,
1360                                    $expiry_date, $pickup_locn, $hold_type,
1361                                    $fee_ack);
1362     } else {
1363         syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
1364                $hold_mode, $server->{account}->{id});
1365         $status = $ils->Transaction::Hold;
1366         $status->screen_msg("System error. Please contact library status");
1367     }
1368
1369     $resp .= $status->ok;
1370     $resp .= sipbool($status->item && $status->item->available($patron_id));
1371     $resp .= Sip::timestamp;
1372
1373     if ($status->ok) {
1374         $resp .= add_field(FID_PATRON_ID, $status->patron->id);
1375
1376         if ($status->expiration_date) {
1377             $resp .= maybe_add(FID_EXPIRATION,
1378                                Sip::timestamp($status->expiration_date));
1379         }
1380         $resp .= maybe_add(FID_QUEUE_POS,   $status->queue_position);
1381         $resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
1382         $resp .= maybe_add(FID_ITEM_ID,     $status->item->id);
1383         $resp .= maybe_add(FID_TITLE_ID,    $status->item->title_id);
1384     } else {
1385         # Not ok.  still need required fields
1386         $resp .= add_field(FID_PATRON_ID, $patron_id);
1387     }
1388
1389     $resp .= add_field(FID_INST_ID, $ils->institution);
1390     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1391     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1392
1393     $self->write_msg($resp, undef, $server->{encoding});
1394
1395     return(HOLD);
1396 }
1397
1398 sub handle_renew {
1399     my ($self, $server) = @_;
1400     my $ils = $server->{ils};
1401     my ($third_party, $no_block, $trans_date, $nb_due_date);
1402     my ($patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack);
1403     my $fields = $self->{fields};
1404     my $status;
1405     my ($patron, $item);
1406     my $resp = RENEW_RESP;
1407
1408     ($third_party, $no_block, $trans_date, $nb_due_date) =
1409         @{$self->{fixed_fields}};
1410
1411     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
1412
1413     if ($no_block eq 'Y') {
1414         syslog("LOG_WARNING",
1415                "handle_renew: recieved 'no block' renewal from terminal '%s'",
1416                $server->{account}->{id});
1417     }
1418
1419     $patron_id  = $fields->{(FID_PATRON_ID)};
1420     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1421     $item_id    = $fields->{(FID_ITEM_ID)};
1422     $title_id   = $fields->{(FID_TITLE_ID)};
1423     $item_props = $fields->{(FID_ITEM_PROPS)};
1424     $fee_ack    = $fields->{(FID_FEE_ACK)};
1425
1426     $status = $ils->renew($patron_id, $patron_pwd, $item_id, $title_id,
1427                           $no_block, $nb_due_date, $third_party,
1428                           $item_props, $fee_ack);
1429
1430     $patron = $status->patron;
1431     $item   = $status->item;
1432
1433     if ($status->ok) {
1434         $resp .= '1';
1435         $resp .= $status->renewal_ok ? 'Y' : 'N';
1436         if ($ils->supports('magnetic media')) {
1437             $resp .= sipbool($item->magnetic);
1438         } else {
1439             $resp .= 'U';
1440         }
1441     $resp .= sipbool($status->desensitize);
1442     $resp .= Sip::timestamp;
1443     $resp .= add_field(FID_PATRON_ID, $patron->id);
1444     $resp .= add_field(FID_ITEM_ID,   $item->id);
1445     $resp .= add_field(FID_TITLE_ID,  $item->title_id);
1446     $resp .= add_field(FID_DUE_DATE,  $item->due_date);
1447     if ($ils->supports('security inhibit')) {
1448         $resp .= add_field(FID_SECURITY_INHIBIT, $status->security_inhibit);
1449     }
1450         $resp .= add_field(FID_MEDIA_TYPE, $item->sip_media_type);
1451         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1452     } else {
1453         # renew failed for some reason
1454         # not OK, renewal not OK, Unknown media type (why bother checking?)
1455         $resp .= '0NUN';
1456         $resp .= Sip::timestamp;
1457         # If we found the patron or the item, the return the ILS
1458         # information, otherwise echo back the infomation we received
1459         # from the terminal
1460     $resp .= add_field(FID_PATRON_ID, $patron ? $patron->id     : $patron_id);
1461     $resp .= add_field(FID_ITEM_ID,   $item   ? $item->id       : $item_id  );
1462     $resp .= add_field(FID_TITLE_ID,  $item   ? $item->title_id : $title_id );
1463     $resp .= add_field(FID_DUE_DATE, '');
1464     }
1465
1466     if ($status->fee_amount) {
1467         $resp .= add_field(FID_FEE_AMT,        $status->fee_amount);
1468         $resp .= maybe_add(FID_CURRENCY,       $status->sip_currency);
1469         $resp .= maybe_add(FID_FEE_TYPE,       $status->sip_fee_type);
1470         $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1471     }
1472
1473     $resp .= add_field(FID_INST_ID, $ils->institution);
1474     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1475     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1476
1477     $self->write_msg($resp, undef, $server->{encoding});
1478
1479     return(RENEW);
1480 }
1481
1482 sub handle_renew_all {
1483     my ($self, $server) = @_;
1484     my $ils = $server->{ils};
1485     my ($trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack);
1486     my $fields = $self->{fields};
1487     my $resp = RENEW_ALL_RESP;
1488     my $status;
1489     my (@renewed, @unrenewed);
1490
1491     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew_all");
1492
1493     ($trans_date) = @{$self->{fixed_fields}};
1494
1495     $patron_id    = $fields->{(FID_PATRON_ID)};
1496     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
1497     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
1498     $fee_ack      = $fields->{(FID_FEE_ACK)};
1499
1500     $status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack);
1501
1502     $resp .= $status->ok ? '1' : '0';
1503
1504     if (!$status->ok) {
1505         $resp .= add_count("renew_all/renewed_count", 0);
1506         $resp .= add_count("renew_all/unrenewed_count", 0);
1507         @renewed = [];
1508         @unrenewed = [];
1509     } else {
1510         @renewed = @{$status->renewed};
1511         @unrenewed = @{$status->unrenewed};
1512         $resp .= add_count("renew_all/renewed_count", scalar @renewed);
1513         $resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
1514     }
1515
1516     $resp .= Sip::timestamp;
1517     $resp .= add_field(FID_INST_ID, $ils->institution);
1518
1519     $resp .= join('', map(add_field(FID_RENEWED_ITEMS, $_), @renewed));
1520     $resp .= join('', map(add_field(FID_UNRENEWED_ITEMS, $_), @unrenewed));
1521
1522     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1523     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1524
1525     $self->write_msg($resp, undef, $server->{encoding});
1526
1527     return(RENEW_ALL);
1528 }
1529
1530 #
1531 # send_acs_status($self, $server)
1532 #
1533 # Send an ACS Status message, which is contains lots of little fields
1534 # of information gleaned from all sorts of places.
1535 #
1536
1537 my @message_type_names = (
1538                           "patron status request",
1539                           "checkout",
1540                           "checkin",
1541                           "block patron",
1542                           "acs status",
1543                           "request sc/acs resend",
1544                           "login",
1545                           "patron information",
1546                           "end patron session",
1547                           "fee paid",
1548                           "item information",
1549                           "item status update",
1550                           "patron enable",
1551                           "hold",
1552                           "renew",
1553                           "renew all",
1554                          );
1555
1556 sub send_acs_status {
1557     my ($self, $server, $screen_msg, $print_line) = @_;
1558     my $msg = ACS_STATUS;
1559     my $account = $server->{account};
1560     my $policy  = $server->{policy};
1561     my $ils     = $server->{ils};
1562     my ($online_status, $checkin_ok, $checkout_ok, $ACS_renewal_policy);
1563     my ($status_update_ok, $offline_ok, $timeout, $retries);
1564
1565     $online_status = 'Y';
1566     $checkout_ok        = sipbool($ils->checkout_ok);
1567     $checkin_ok         = sipbool($ils->checkin_ok);
1568     $ACS_renewal_policy = sipbool($policy->{renewal});
1569     $status_update_ok   = sipbool($ils->status_update_ok);
1570     $offline_ok         = sipbool($ils->offline_ok);
1571     $timeout = sprintf("%03d", $policy->{timeout});
1572     $retries = sprintf("%03d", $policy->{retries});
1573
1574     if (length($timeout) != 3) {
1575         syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", $timeout);
1576         $timeout = '000';
1577     }
1578
1579     if (length($retries) != 3) {
1580         syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries);
1581         $retries = '000';
1582     }
1583
1584     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1585     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1586     $msg .= Sip::timestamp();
1587
1588     if ($protocol_version == 1) {
1589         $msg .= '1.00';
1590     } elsif ($protocol_version == 2) {
1591         $msg .= '2.00';
1592     } else {
1593         syslog("LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version);
1594         $msg .= '1.00';
1595     }
1596
1597     # Institution ID
1598     $msg .= add_field(FID_INST_ID, $account->{institution});
1599
1600     if ($protocol_version >= 2) {
1601     # Supported messages: we do it all
1602     my $supported_msgs = '';
1603
1604     foreach my $msg_name (@message_type_names) {
1605         if ( $msg_name eq 'request sc/acs resend' ) {
1606             $supported_msgs .= Sip::sipbool(1);
1607         } else {
1608             $supported_msgs .= Sip::sipbool( $ils->supports($msg_name) );
1609         }
1610     }
1611     if (length($supported_msgs) < 16) {
1612         syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
1613     }
1614         $msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
1615     }
1616
1617     $msg .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1618
1619     if (defined($account->{print_width}) && defined($print_line)
1620              && $account->{print_width}  <  length( $print_line)) {
1621         syslog("LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line);
1622         $print_line = substr($print_line, 0, $account->{print_width});
1623     }
1624
1625     $msg .= maybe_add(FID_PRINT_LINE, $print_line);
1626
1627     # Do we want to tell the terminal its location?
1628
1629     $self->write_msg($msg, undef, $server->{encoding});
1630     return 1;
1631 }
1632
1633 #
1634 # patron_status_string: create the 14-char patron status
1635 # string for the Patron Status message
1636 #
1637 sub patron_status_string {
1638     my $patron = shift;
1639     syslog("LOG_DEBUG", "patron_status_string for %s charge_ok: %s", $patron->id, $patron->charge_ok);
1640     my $patron_status = sprintf('%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1641         denied($patron->charge_ok),
1642         denied($patron->renew_ok),
1643         denied($patron->recall_ok),
1644         denied($patron->hold_ok),
1645         boolspace($patron->card_lost),
1646         boolspace($patron->too_many_charged),
1647         boolspace($patron->too_many_overdue),
1648         boolspace($patron->too_many_renewal),
1649         boolspace($patron->too_many_claim_return),
1650         boolspace($patron->too_many_lost),
1651         boolspace($patron->excessive_fines),
1652         boolspace($patron->excessive_fees),
1653         boolspace($patron->recall_overdue),
1654         boolspace($patron->too_many_billed)
1655     );
1656     return $patron_status;
1657 }
1658
1659 1;