C4/SIP/Sip/MsgType.pm

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