Sip/MsgType.pm

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