C4/SIP/Sip/MsgType.pm

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