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