C4/SIP/Sip/MsgType.pm

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