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