Sip/MsgType.pm

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