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     if ($item->due_date) {
 548         $resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));
 549     } else {
 550         $resp .= add_field(FID_DUE_DATE, q{});
 551     }
 552
 553         $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 554         $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 555
 556         if ($protocol_version >= 2) {
 557             if ($ils->supports('security inhibit')) {
 558                 $resp .= add_field(FID_SECURITY_INHIBIT,
 559                                    $status->security_inhibit);
 560             }
 561             $resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type);
 562             $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
 563
 564             # Financials
 565             if ($status->fee_amount) {
 566                 $resp .= add_field(FID_FEE_AMT, $status->fee_amount);
 567                 $resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
 568                 $resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
 569                 $resp .= maybe_add(FID_TRANSACTION_ID,
 570                                    $status->transaction_id);
 571             }
 572         }
 573
 574     } else {
 575         # Checkout failed
 576         # Checkout Response: not ok, no renewal, don't know mag. media,
 577         # no desensitize
 578         $resp = sprintf("120NUN%s", Sip::timestamp);
 579         $resp .= add_field(FID_INST_ID, $inst);
 580         $resp .= add_field(FID_PATRON_ID, $patron_id);
 581         $resp .= add_field(FID_ITEM_ID, $item_id);
 582
 583         # If the item is valid, provide the title, otherwise
 584         # leave it blank
 585         $resp .= add_field(FID_TITLE_ID, $item ? $item->title_id : '');
 586         # Due date is required.  Since it didn't get checked out,
 587         # it's not due, so leave the date blank
 588         $resp .= add_field(FID_DUE_DATE, '');
 589
 590         $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 591         $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 592
 593         if ($protocol_version >= 2) {
 594             # Is the patron ID valid?
 595             $resp .= add_field(FID_VALID_PATRON, sipbool($patron));
 596
 597             if ($patron && exists($fields->{FID_PATRON_PWD})) {
 598                 # Password provided, so we can tell if it was valid or not
 599                 $resp .= add_field(FID_VALID_PATRON_PWD,
 600                                    sipbool($patron->check_password($fields->{(FID_PATRON_PWD)})));
 601             }
 602         }
 603     }
 604
 605     $self->write_msg($resp);
 606     return(CHECKOUT);
 607 }
 608
 609 sub handle_checkin {
 610     my ($self, $server) = @_;
 611     my $account = $server->{account};
 612     my $ils     = $server->{ils};
 613     my ($current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel);
 614     my ($patron, $item, $status);
 615     my $resp = CHECKIN_RESP;
 616     my ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}};
 617         my $fields = $self->{fields};
 618
 619         $current_loc = $fields->{(FID_CURRENT_LOCN)};
 620         $inst_id     = $fields->{(FID_INST_ID)};
 621         $item_id     = $fields->{(FID_ITEM_ID)};
 622         $item_props  = $fields->{(FID_ITEM_PROPS)};
 623         $cancel      = $fields->{(FID_CANCEL)};
 624
 625     $ils->check_inst_id($inst_id, "handle_checkin");
 626
 627     if ($no_block eq 'Y') {
 628         # Off-line transactions, ick.
 629         syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id});
 630         $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel);
 631     } else {
 632         $status = $ils->checkin($item_id, $trans_date, $return_date, $current_loc, $item_props, $cancel);
 633     }
 634
 635     $patron = $status->patron;
 636     $item   = $status->item;
 637
 638     $resp .= $status->ok ? '1' : '0';
 639     $resp .= $status->resensitize ? 'Y' : 'N';
 640     if ($item && $ils->supports('magnetic media')) {
 641                 $resp .= sipbool($item->magnetic_media);
 642     } else {
 643         # item barcode is invalid or system doesn't support 'magnetic media' indicator
 644                 $resp .= 'U';
 645     }
 646
 647     # apparently we can't trust the returns from Checkin yet (because C4::Circulation::AddReturn is faulty)
 648     # So we reproduce the alert logic here.
 649     if (not $status->alert) {
 650         if ($item->hold_patron_id) {
 651             $status->alert(1);
 652             if ($item->destination_loc and $item->destination_loc ne $current_loc) {
 653                 $status->alert_type('02');  # hold at other library
 654             } else {
 655                 $status->alert_type('01');  # hold at this library
 656             }
 657         } elsif ($item->destination_loc and $item->destination_loc ne $current_loc) {
 658             $status->alert(1);
 659             $status->alert_type('04');  # no hold, just send it
 660         }
 661     }
 662     $resp .= $status->alert ? 'Y' : 'N';
 663     $resp .= Sip::timestamp;
 664     $resp .= add_field(FID_INST_ID, $inst_id);
 665     $resp .= add_field(FID_ITEM_ID, $item_id);
 666
 667     if ($item) {
 668         $resp .= add_field(FID_PERM_LOCN, $item->permanent_location);
 669         $resp .= maybe_add(FID_TITLE_ID,  $item->title_id);
 670     }
 671
 672     if ($protocol_version >= 2) {
 673         $resp .= maybe_add(FID_SORT_BIN, $status->sort_bin);
 674         if ($patron) {
 675             $resp .= add_field(FID_PATRON_ID, $patron->id);
 676         }
 677         if ($item) {
 678             $resp .= maybe_add(FID_MEDIA_TYPE,           $item->sip_media_type     );
 679             $resp .= maybe_add(FID_ITEM_PROPS,           $item->sip_item_properties);
 680             $resp .= maybe_add(FID_COLLECTION_CODE,      $item->collection_code    );
 681             $resp .= maybe_add(FID_CALL_NUMBER,          $item->call_number        );
 682             $resp .= maybe_add(FID_DESTINATION_LOCATION, $item->destination_loc    );
 683             $resp .= maybe_add(FID_HOLD_PATRON_ID,       $item->hold_patron_bcode     );
 684             $resp .= maybe_add(FID_HOLD_PATRON_NAME,     $item->hold_patron_name   );
 685             if ($status->hold and $status->hold->{branchcode} ne $item->destination_loc) {
 686                 warn 'SIP hold mismatch: $status->hold->{branchcode}=' . $status->hold->{branchcode} . '; $item->destination_loc=' . $item->destination_loc;
 687                 # just me being paranoid.
 688             }
 689         }
 690     }
 691
 692     $resp .= maybe_add(FID_ALERT_TYPE, $status->alert_type) if $status->alert;
 693     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
 694     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
 695
 696     $self->write_msg($resp);
 697
 698     return(CHECKIN);
 699 }
 700
 701 sub handle_block_patron {
 702     my ($self, $server) = @_;
 703     my $account = $server->{account};
 704     my $ils = $server->{ils};
 705     my ($card_retained, $trans_date);
 706     my ($inst_id, $blocked_card_msg, $patron_id, $terminal_pwd);
 707     my ($fields,$resp,$patron);
 708
 709     ($card_retained, $trans_date) = @{$self->{fixed_fields}};
 710     $fields = $self->{fields};
 711     $inst_id          = $fields->{(FID_INST_ID)};
 712     $blocked_card_msg = $fields->{(FID_BLOCKED_CARD_MSG)};
 713     $patron_id        = $fields->{(FID_PATRON_ID)};
 714     $terminal_pwd     = $fields->{(FID_TERMINAL_PWD)};
 715
 716     # Terminal passwords are different from account login
 717     # passwords, but I have no idea what to do with them.  So,
 718     # I'll just ignore them for now.
 719
 720         # FIXME ???
 721
 722     $ils->check_inst_id($inst_id, "block_patron");
 723     $patron = $ils->find_patron($patron_id);
 724
 725     # The correct response for a "Block Patron" message is a
 726     # "Patron Status Response", so use that handler to generate
 727     # the message, but then return the correct code from here.
 728     #
 729     # Normally, the language is provided by the "Patron Status"
 730     # fixed field, but since we're not responding to one of those
 731     # we'll just say, "Unspecified", as per the spec.  Let the
 732     # terminal default to something that, one hopes, will be
 733     # intelligible
 734         if ($patron) {
 735                 # Valid patron id
 736                 $patron->block($card_retained, $blocked_card_msg);
 737         }
 738
 739     $resp = build_patron_status($patron, $patron->language, $fields);
 740     $self->write_msg($resp);
 741     return(BLOCK_PATRON);
 742 }
 743
 744 sub handle_sc_status {
 745     my ($self, $server) = @_;
 746         ($server) or warn "handle_sc_status error: no \$server argument received.";
 747         my ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}};
 748         my ($new_proto);
 749
 750         if ($sc_protocol_version =~ /^1\./) {
 751                 $new_proto = 1;
 752         } elsif ($sc_protocol_version =~ /^2\./) {
 753                 $new_proto = 2;
 754         } else {
 755                 syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version);
 756                 $new_proto = 1;
 757         }
 758
 759         if ($new_proto != $protocol_version) {
 760                 syslog("LOG_INFO", "Setting protocol level to $new_proto");
 761                 $protocol_version = $new_proto;
 762         }
 763
 764     if ($status == SC_STATUS_PAPER) {
 765         syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
 766                $self->{account}->{id}, $self->{account}->{institution});
 767     } elsif ($status == SC_STATUS_SHUTDOWN) {
 768         syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
 769                $self->{account}->{id}, $self->{account}->{institution});
 770     }
 771
 772     $self->{account}->{print_width} = $print_width;
 773     return (send_acs_status($self, $server) ? SC_STATUS : '');
 774 }
 775
 776 sub handle_request_acs_resend {
 777     my ($self, $server) = @_;
 778
 779     if (!$last_response) {
 780         # We haven't sent anything yet, so respond with a
 781         # REQUEST_SC_RESEND msg (p. 16)
 782         $self->write_msg(REQUEST_SC_RESEND);
 783     } elsif ((length($last_response) < 9)
 784              || substr($last_response, -9, 2) ne 'AY') {
 785         # When resending a message, we aren't supposed to include
 786         # a sequence number, even if the original had one (p. 4).
 787         # If the last message didn't have a sequence number, then
 788         # we can just send it.
 789         print("$last_response\r");      # not write_msg?
 790     } else {
 791         # Cut out the sequence number and checksum, since the old
 792         # checksum is wrong for the resent message.
 793         my $rebuilt = substr($last_response, 0, -9);
 794         $self->write_msg($rebuilt);
 795     }
 796
 797     return REQUEST_ACS_RESEND;
 798 }
 799
 800 sub login_core ($$$) {
 801         my $server = shift or return undef;
 802         my $uid = shift;
 803         my $pwd = shift;
 804     my $status = 1;             # Assume it all works
 805     if (!exists($server->{config}->{accounts}->{$uid})) {
 806                 syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'");
 807                 $status = 0;
 808     } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
 809                 syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'");
 810                 $status = 0;
 811     } else {
 812         # Store the active account someplace handy for everybody else to find.
 813                 $server->{account} = $server->{config}->{accounts}->{$uid};
 814                 my $inst = $server->{account}->{institution};
 815                 $server->{institution} = $server->{config}->{institutions}->{$inst};
 816                 $server->{policy} = $server->{institution}->{policy};
 817                 $server->{sip_username} = $uid;
 818                 $server->{sip_password} = $pwd;
 819
 820                 my $auth_status = api_auth($uid,$pwd);
 821                 if (!$auth_status or $auth_status !~ /^ok$/i) {
 822                         syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s",
 823                                                 $uid, $inst, ($auth_status||'unknown'));
 824                         $status = 0;
 825                 } else {
 826                         syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst);
 827                         #
 828                         # initialize connection to ILS
 829                         #
 830                         my $module = $server->{config}->{institutions}->{$inst}->{implementation};
 831                         syslog("LOG_DEBUG", 'login_core: ' . Dumper($module));
 832                         $module->use;
 833                         if ($@) {
 834                                 syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed",
 835                                                 $server->{service}, $module, $inst);
 836                                 die("Failed to load ILS implementation '$module' for $inst");
 837                         }
 838
 839                         # like   ILS->new(), I think.
 840                         $server->{ils} = $module->new($server->{institution}, $server->{account});
 841                         if (!$server->{ils}) {
 842                             syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst);
 843                             die("Unable to connect to ILS '$inst'");
 844                         }
 845                 }
 846         }
 847         return $status;
 848 }
 849
 850 sub handle_login {
 851     my ($self, $server) = @_;
 852     my ($uid_algorithm, $pwd_algorithm);
 853     my ($uid, $pwd);
 854     my $inst;
 855     my $fields;
 856     my $status = 1;             # Assume it all works
 857
 858     $fields = $self->{fields};
 859     ($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}};
 860
 861     $uid = $fields->{(FID_LOGIN_UID)}; # Terminal ID, not patron ID.
 862     $pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD.
 863
 864     if ($uid_algorithm || $pwd_algorithm) {
 865                 syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm");
 866                 $status = 0;
 867     }
 868         else { $status = login_core($server,$uid,$pwd); }
 869
 870         $self->write_msg(LOGIN_RESP . $status);
 871     return $status ? LOGIN : '';
 872 }
 873
 874 #
 875 # Build the detailed summary information for the Patron
 876 # Information Response message based on the first 'Y' that appears
 877 # in the 'summary' field of the Patron Information reqest.  The
 878 # specification says that only one 'Y' can appear in that field,
 879 # and we're going to believe it.
 880 #
 881 sub summary_info {
 882     my ($ils, $patron, $summary, $start, $end) = @_;
 883     my $resp = '';
 884     my $summary_type;
 885     #
 886     # Map from offsets in the "summary" field of the Patron Information
 887     # message to the corresponding field and handler
 888     #
 889     my @summary_map = (
 890         { func => $patron->can(   "hold_items"), fid => FID_HOLD_ITEMS             },
 891         { func => $patron->can("overdue_items"), fid => FID_OVERDUE_ITEMS          },
 892         { func => $patron->can("charged_items"), fid => FID_CHARGED_ITEMS          },
 893         { func => $patron->can(   "fine_items"), fid => FID_FINE_ITEMS             },
 894         { func => $patron->can( "recall_items"), fid => FID_RECALL_ITEMS           },
 895         { func => $patron->can("unavail_holds"), fid => FID_UNAVAILABLE_HOLD_ITEMS },
 896     );
 897
 898     if (($summary_type = index($summary, 'Y')) == -1) {
 899         return '';  # No detailed information required
 900     }
 901
 902     syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
 903         $summary_type, $summary_map[$summary_type]->{fid});
 904
 905     my $func = $summary_map[$summary_type]->{func};
 906     my $fid  = $summary_map[$summary_type]->{fid};
 907     my $itemlist = &$func($patron, $start, $end);
 908
 909     syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
 910     foreach my $i (@{$itemlist}) {
 911         $resp .= add_field($fid, $i->{barcode});
 912     }
 913
 914     return $resp;
 915 }
 916
 917 sub handle_patron_info {
 918     my ($self, $server) = @_;
 919     my $ils = $server->{ils};
 920     my ($lang, $trans_date, $summary) = @{$self->{fixed_fields}};
 921     my $fields = $self->{fields};
 922     my ($inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end);
 923     my ($resp, $patron, $count);
 924
 925     $inst_id      = $fields->{(FID_INST_ID)};
 926     $patron_id    = $fields->{(FID_PATRON_ID)};
 927     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
 928     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
 929     $start        = $fields->{(FID_START_ITEM)};
 930     $end          = $fields->{(FID_END_ITEM)};
 931
 932     $patron = $ils->find_patron($patron_id);
 933
 934     $resp = (PATRON_INFO_RESP);
 935     if ($patron) {
 936         $resp .= patron_status_string($patron);
 937         $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language;
 938         $resp .= Sip::timestamp();
 939
 940         $resp .= add_count('patron_info/hold_items',
 941             scalar @{$patron->hold_items});
 942         $resp .= add_count('patron_info/overdue_items',
 943             scalar @{$patron->overdue_items});
 944         $resp .= add_count('patron_info/charged_items',
 945             scalar @{$patron->charged_items});
 946         $resp .= add_count('patron_info/fine_items',
 947             scalar @{$patron->fine_items});
 948         $resp .= add_count('patron_info/recall_items',
 949             scalar @{$patron->recall_items});
 950         $resp .= add_count('patron_info/unavail_holds',
 951             scalar @{$patron->unavail_holds});
 952
 953         $resp .= add_field(FID_INST_ID,       ($ils->institution_id || 'SIP2'));
 954
 955         # while the patron ID we got from the SC is valid, let's
 956         # use the one returned from the ILS, just in case...
 957         $resp .= add_field(FID_PATRON_ID,     $patron->id);
 958         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
 959
 960         # TODO: add code for the fields
 961         #   hold items limit
 962         #   overdue items limit
 963         #   charged items limit
 964
 965         $resp .= add_field(FID_VALID_PATRON, 'Y');
 966         if (defined($patron_pwd)) {
 967             # If patron password was provided, report whether it was right or not.
 968             $resp .= add_field(FID_VALID_PATRON_PWD,
 969                 sipbool($patron->check_password($patron_pwd)));
 970         }
 971
 972         $resp .= maybe_add(FID_CURRENCY,   $patron->currency);
 973         $resp .= maybe_add(FID_FEE_AMT,    $patron->fee_amount);
 974         $resp .= add_field(FID_FEE_LMT,    $patron->fee_limit);
 975
 976         # TODO: zero or more item details for 2.0 can go here:
 977         #          hold_items
 978         #       overdue_items
 979         #       charged_items
 980         #          fine_items
 981         #        recall_items
 982
 983         $resp .= summary_info($ils, $patron, $summary, $start, $end);
 984
 985         $resp .= maybe_add(FID_HOME_ADDR,  $patron->address);
 986         $resp .= maybe_add(FID_EMAIL,      $patron->email_addr);
 987         $resp .= maybe_add(FID_HOME_PHONE, $patron->home_phone);
 988
 989         # SIP 2.0 extensions used by Envisionware
 990         # Other terminals will ignore unrecognized fields (unrecognized field identifiers)
 991         $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->birthdate);
 992         $resp .= maybe_add(FID_PATRON_CLASS,     $patron->ptype);
 993
 994         # Custom protocol extension to report patron internet privileges
 995         $resp .= maybe_add(FID_INET_PROFILE,     $patron->inet_privileges);
 996
 997         $resp .= maybe_add(FID_SCREEN_MSG,       $patron->screen_msg);
 998         $resp .= maybe_add(FID_PRINT_LINE,       $patron->print_line);
 999     } else {
1000         # Invalid patron ID:
1001         # no privileges, no items associated,
1002         # no personal name, and is invalid (if we're using 2.00)
1003         $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
1004         $resp .= '0000' x 6;
1005
1006         $resp .= add_field(FID_INST_ID,       ($ils->institution_id || 'SIP2'));
1007         # patron ID is invalid, but field is required, so just echo it back
1008         $resp .= add_field(FID_PATRON_ID,     $fields->{(FID_PATRON_ID)});
1009         $resp .= add_field(FID_PERSONAL_NAME, '');
1010
1011         if ($protocol_version >= 2) {
1012             $resp .= add_field(FID_VALID_PATRON, 'N');
1013         }
1014     }
1015
1016     $self->write_msg($resp);
1017     return(PATRON_INFO);
1018 }
1019
1020 sub handle_end_patron_session {
1021     my ($self, $server) = @_;
1022     my $ils = $server->{ils};
1023     my $trans_date;
1024     my $fields = $self->{fields};
1025     my $resp = END_SESSION_RESP;
1026     my ($status, $screen_msg, $print_line);
1027
1028     ($trans_date) = @{$self->{fixed_fields}};
1029
1030     $ils->check_inst_id($fields->{FID_INST_ID}, "handle_end_patron_session");
1031
1032     ($status, $screen_msg, $print_line) = $ils->end_patron_session($fields->{(FID_PATRON_ID)});
1033
1034     $resp .= $status ? 'Y' : 'N';
1035     $resp .= Sip::timestamp();
1036
1037     $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1038     $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
1039
1040     $resp .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1041     $resp .= maybe_add(FID_PRINT_LINE, $print_line);
1042
1043     $self->write_msg($resp);
1044
1045     return(END_PATRON_SESSION);
1046 }
1047
1048 sub handle_fee_paid {
1049     my ($self, $server) = @_;
1050     my $ils = $server->{ils};
1051     my ($trans_date, $fee_type, $pay_type, $currency) = $self->{fixed_fields};
1052     my $fields = $self->{fields};
1053     my ($fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd);
1054     my ($fee_id, $trans_id);
1055     my $status;
1056     my $resp = FEE_PAID_RESP;
1057
1058     $fee_amt = $fields->{(FID_FEE_AMT)};
1059     $inst_id = $fields->{(FID_INST_ID)};
1060     $patron_id = $fields->{(FID_PATRON_ID)};
1061     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1062     $fee_id = $fields->{(FID_FEE_ID)};
1063     $trans_id = $fields->{(FID_TRANSACTION_ID)};
1064
1065     $ils->check_inst_id($inst_id, "handle_fee_paid");
1066
1067     $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
1068                            $pay_type, $fee_id, $trans_id, $currency);
1069
1070     $resp .= ($status->ok ? 'Y' : 'N') . Sip::timestamp;
1071     $resp .= add_field(FID_INST_ID, $inst_id);
1072     $resp .= add_field(FID_PATRON_ID, $patron_id);
1073     $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1074     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1075     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1076
1077     $self->write_msg($resp);
1078
1079     return(FEE_PAID);
1080 }
1081
1082 sub handle_item_information {
1083     my ($self, $server) = @_;
1084     my $ils = $server->{ils};
1085     my $trans_date;
1086     my $fields = $self->{fields};
1087     my $resp = ITEM_INFO_RESP;
1088     my $item;
1089     my $i;
1090
1091     ($trans_date) = @{$self->{fixed_fields}};
1092
1093     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_item_information");
1094
1095     $item =  $ils->find_item($fields->{(FID_ITEM_ID)});
1096
1097     if (!defined($item)) {
1098         # Invalid Item ID
1099         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1100         $resp .= "010101";
1101         $resp .= Sip::timestamp;
1102         # Just echo back the invalid item id
1103         $resp .= add_field(FID_ITEM_ID, $fields->{(FID_ITEM_ID)});
1104         # title id is required, but we don't have one
1105         $resp .= add_field(FID_TITLE_ID, '');
1106     } else {
1107         # Valid Item ID, send the good stuff
1108         $resp .= $item->sip_circulation_status;
1109         $resp .= $item->sip_security_marker;
1110         $resp .= $item->sip_fee_type;
1111         $resp .= Sip::timestamp;
1112
1113         $resp .= add_field(FID_ITEM_ID,  $item->id);
1114         $resp .= add_field(FID_TITLE_ID, $item->title_id);
1115
1116         $resp .= maybe_add(FID_MEDIA_TYPE,   $item->sip_media_type);
1117         $resp .= maybe_add(FID_PERM_LOCN,    $item->permanent_location);
1118         $resp .= maybe_add(FID_CURRENT_LOCN, $item->current_location);
1119         $resp .= maybe_add(FID_ITEM_PROPS,   $item->sip_item_properties);
1120
1121         if (($i = $item->fee) != 0) {
1122             $resp .= add_field(FID_CURRENCY, $item->fee_currency);
1123             $resp .= add_field(FID_FEE_AMT, $i);
1124         }
1125         $resp .= maybe_add(FID_OWNER, $item->owner);
1126
1127         if (($i = scalar @{$item->hold_queue}) > 0) {
1128             $resp .= add_field(FID_HOLD_QUEUE_LEN, $i);
1129         }
1130         if ($item->due_date) {
1131             $resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));
1132         }
1133         if (($i = $item->recall_date) != 0) {
1134             $resp .= add_field(FID_RECALL_DATE, Sip::timestamp($i));
1135         }
1136         if (($i = $item->hold_pickup_date) != 0) {
1137             $resp .= add_field(FID_HOLD_PICKUP_DATE, Sip::timestamp($i));
1138         }
1139
1140         $resp .= maybe_add(FID_SCREEN_MSG, $item->screen_msg);
1141         $resp .= maybe_add(FID_PRINT_LINE, $item->print_line);
1142     }
1143
1144     $self->write_msg($resp);
1145
1146     return(ITEM_INFORMATION);
1147 }
1148
1149 sub handle_item_status_update {
1150     my ($self, $server) = @_;
1151     my $ils = $server->{ils};
1152     my ($trans_date, $item_id, $terminal_pwd, $item_props);
1153     my $fields = $self->{fields};
1154     my $status;
1155     my $item;
1156     my $resp = ITEM_STATUS_UPDATE_RESP;
1157
1158     ($trans_date) = @{$self->{fixed_fields}};
1159
1160     $ils->check_inst_id($fields->{(FID_INST_ID)});
1161
1162     $item_id = $fields->{(FID_ITEM_ID)};
1163     $item_props = $fields->{(FID_ITEM_PROPS)};
1164
1165         if (!defined($item_id)) {
1166                 syslog("LOG_WARNING",
1167                         "handle_item_status: received message without Item ID field");
1168     } else {
1169                 $item = $ils->find_item($item_id);
1170         }
1171
1172     if (!$item) {
1173         # Invalid Item ID
1174         $resp .= '0';
1175         $resp .= Sip::timestamp;
1176         $resp .= add_field(FID_ITEM_ID, $item_id);
1177     } else {
1178         # Valid Item ID
1179
1180         $status = $item->status_update($item_props);
1181
1182         $resp .= $status->ok ? '1' : '0';
1183         $resp .= Sip::timestamp;
1184
1185         $resp .= add_field(FID_ITEM_ID, $item->id);
1186         $resp .= add_field(FID_TITLE_ID, $item->title_id);
1187         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1188     }
1189
1190     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1191     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1192
1193     $self->write_msg($resp);
1194
1195     return(ITEM_STATUS_UPDATE);
1196 }
1197
1198 sub handle_patron_enable {
1199     my ($self, $server) = @_;
1200     my $ils = $server->{ils};
1201     my $fields = $self->{fields};
1202     my ($trans_date, $patron_id, $terminal_pwd, $patron_pwd);
1203     my ($status, $patron);
1204     my $resp = PATRON_ENABLE_RESP;
1205
1206     ($trans_date) = @{$self->{fixed_fields}};
1207     $patron_id = $fields->{(FID_PATRON_ID)};
1208     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1209
1210     syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
1211            $patron_id, $patron_pwd);
1212
1213     $patron = $ils->find_patron($patron_id);
1214
1215     if (!defined($patron)) {
1216         # Invalid patron ID
1217         $resp .= 'YYYY' . (' ' x 10) . '000' . Sip::timestamp();
1218         $resp .= add_field(FID_PATRON_ID, $patron_id);
1219         $resp .= add_field(FID_PERSONAL_NAME, '');
1220         $resp .= add_field(FID_VALID_PATRON, 'N');
1221         $resp .= add_field(FID_VALID_PATRON_PWD, 'N');
1222     } else {
1223         # valid patron
1224         if (!defined($patron_pwd) || $patron->check_password($patron_pwd)) {
1225             # Don't enable the patron if there was an invalid password
1226             $status = $patron->enable;
1227         }
1228         $resp .= patron_status_string($patron);
1229         $resp .= $patron->language . Sip::timestamp();
1230
1231         $resp .= add_field(FID_PATRON_ID, $patron->id);
1232         $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
1233         if (defined($patron_pwd)) {
1234             $resp .= add_field(FID_VALID_PATRON_PWD,
1235                                sipbool($patron->check_password($patron_pwd)));
1236         }
1237         $resp .= add_field(FID_VALID_PATRON, 'Y');
1238         $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
1239         $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
1240     }
1241
1242     $resp .= add_field(FID_INST_ID, $ils->institution);
1243
1244     $self->write_msg($resp);
1245
1246     return(PATRON_ENABLE);
1247 }
1248
1249 sub handle_hold {
1250     my ($self, $server) = @_;
1251     my $ils = $server->{ils};
1252     my ($hold_mode, $trans_date);
1253     my ($expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd);
1254     my ($item_id, $title_id, $fee_ack);
1255     my $fields = $self->{fields};
1256     my $status;
1257     my $resp = HOLD_RESP;
1258
1259     ($hold_mode, $trans_date) = @{$self->{fixed_fields}};
1260
1261     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_hold");
1262
1263     $patron_id   = $fields->{(FID_PATRON_ID)  };
1264     $expiry_date = $fields->{(FID_EXPIRATION) } || '';
1265     $pickup_locn = $fields->{(FID_PICKUP_LOCN)} || '';
1266     $hold_type   = $fields->{(FID_HOLD_TYPE)  } || '2'; # Any copy of title
1267     $patron_pwd  = $fields->{(FID_PATRON_PWD) };
1268     $item_id     = $fields->{(FID_ITEM_ID)    } || '';
1269     $title_id    = $fields->{(FID_TITLE_ID)   } || '';
1270     $fee_ack     = $fields->{(FID_FEE_ACK)    } || 'N';
1271
1272     if ($hold_mode eq '+') {
1273         $status = $ils->add_hold($patron_id, $patron_pwd, $item_id, $title_id,
1274                                                 $expiry_date, $pickup_locn, $hold_type, $fee_ack);
1275     } elsif ($hold_mode eq '-') {
1276         $status = $ils->cancel_hold($patron_id, $patron_pwd, $item_id, $title_id);
1277     } elsif ($hold_mode eq '*') {
1278         $status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, $title_id,
1279                                                 $expiry_date, $pickup_locn, $hold_type, $fee_ack);
1280     } else {
1281         syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
1282                $hold_mode, $server->{account}->{id});
1283         $status = $ils->Transaction::Hold;              # new?
1284         $status->screen_msg("System error. Please contact library staff.");
1285     }
1286
1287     $resp .= $status->ok;
1288     $resp .= sipbool($status->item  &&  $status->item->available($patron_id));
1289     $resp .= Sip::timestamp;
1290
1291     if ($status->ok) {
1292         $resp .= add_field(FID_PATRON_ID,   $status->patron->id);
1293
1294         ($status->expiration_date) and
1295         $resp .= maybe_add(FID_EXPIRATION,
1296                                      Sip::timestamp($status->expiration_date));
1297         $resp .= maybe_add(FID_QUEUE_POS,   $status->queue_position);
1298         $resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
1299         $resp .= maybe_add(FID_ITEM_ID,     $status->item->id);
1300         $resp .= maybe_add(FID_TITLE_ID,    $status->item->title_id);
1301     } else {
1302         # Not ok.  still need required fields
1303         $resp .= add_field(FID_PATRON_ID,   $patron_id);
1304     }
1305
1306     $resp .= add_field(FID_INST_ID,     $ils->institution);
1307     $resp .= maybe_add(FID_SCREEN_MSG,  $status->screen_msg);
1308     $resp .= maybe_add(FID_PRINT_LINE,  $status->print_line);
1309
1310     $self->write_msg($resp);
1311
1312     return(HOLD);
1313 }
1314
1315 sub handle_renew {
1316     my ($self, $server) = @_;
1317     my $ils = $server->{ils};
1318     my ($third_party, $no_block, $trans_date, $nb_due_date);
1319     my ($patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack);
1320     my $fields = $self->{fields};
1321     my $status;
1322     my ($patron, $item);
1323     my $resp = RENEW_RESP;
1324
1325     ($third_party, $no_block, $trans_date, $nb_due_date) =
1326         @{$self->{fixed_fields}};
1327
1328     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
1329
1330     if ($no_block eq 'Y') {
1331         syslog("LOG_WARNING",
1332                "handle_renew: recieved 'no block' renewal from terminal '%s'",
1333                $server->{account}->{id});
1334     }
1335
1336     $patron_id  = $fields->{(FID_PATRON_ID)};
1337     $patron_pwd = $fields->{(FID_PATRON_PWD)};
1338     $item_id    = $fields->{(FID_ITEM_ID)};
1339     $title_id   = $fields->{(FID_TITLE_ID)};
1340     $item_props = $fields->{(FID_ITEM_PROPS)};
1341     $fee_ack    = $fields->{(FID_FEE_ACK)};
1342
1343     $status = $ils->renew($patron_id, $patron_pwd, $item_id, $title_id,
1344                           $no_block, $nb_due_date, $third_party,
1345                           $item_props, $fee_ack);
1346
1347     $patron = $status->patron;
1348     $item   = $status->item;
1349
1350     if ($status->ok) {
1351         $resp .= '1';
1352         $resp .= $status->renewal_ok ? 'Y' : 'N';
1353         if ($ils->supports('magnetic media')) {
1354             $resp .= sipbool($item->magnetic_media);
1355         } else {
1356             $resp .= 'U';
1357         }
1358         $resp .= sipbool($status->desensitize);
1359         $resp .= Sip::timestamp;
1360         $resp .= add_field(FID_PATRON_ID, $patron->id);
1361         $resp .= add_field(FID_ITEM_ID,  $item->id);
1362         $resp .= add_field(FID_TITLE_ID, $item->title_id);
1363         $resp .= add_field(FID_DUE_DATE, Sip::timestamp($item->due_date));
1364         if ($ils->supports('security inhibit')) {
1365             $resp .= add_field(FID_SECURITY_INHIBIT,
1366                                $status->security_inhibit);
1367         }
1368         $resp .= add_field(FID_MEDIA_TYPE, $item->sip_media_type);
1369         $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
1370     } else {
1371         # renew failed for some reason
1372         # not OK, renewal not OK, Unknown media type (why bother checking?)
1373         $resp .= '0NUN';
1374         $resp .= Sip::timestamp;
1375         # If we found the patron or the item, the return the ILS
1376         # information, otherwise echo back the infomation we received
1377         # from the terminal
1378         $resp .= add_field(FID_PATRON_ID, $patron ? $patron->id     : $patron_id);
1379         $resp .= add_field(FID_ITEM_ID,     $item ? $item->id       : $item_id  );
1380         $resp .= add_field(FID_TITLE_ID,    $item ? $item->title_id : $title_id );
1381         $resp .= add_field(FID_DUE_DATE, '');
1382     }
1383
1384     if ($status->fee_amount) {
1385         $resp .= add_field(FID_FEE_AMT,  $status->fee_amount);
1386         $resp .= maybe_add(FID_CURRENCY, $status->sip_currency);
1387         $resp .= maybe_add(FID_FEE_TYPE, $status->sip_fee_type);
1388         $resp .= maybe_add(FID_TRANSACTION_ID, $status->transaction_id);
1389     }
1390
1391     $resp .= add_field(FID_INST_ID, $ils->institution);
1392     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1393     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1394
1395     $self->write_msg($resp);
1396
1397     return(RENEW);
1398 }
1399
1400 sub handle_renew_all {
1401     # my ($third_party, $no_block, $nb_due_date, $fee_ack, $patron);
1402
1403     my ($self, $server) = @_;
1404     my $ils = $server->{ils};
1405     my ($trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack);
1406     my $fields = $self->{fields};
1407     my $resp = RENEW_ALL_RESP;
1408     my $status;
1409     my (@renewed, @unrenewed);
1410
1411     $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew_all");
1412
1413     ($trans_date) = @{$self->{fixed_fields}};
1414
1415     $patron_id    = $fields->{(FID_PATRON_ID)};
1416     $patron_pwd   = $fields->{(FID_PATRON_PWD)};
1417     $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
1418     $fee_ack      = $fields->{(FID_FEE_ACK)};
1419
1420     $status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack);
1421
1422     $resp .= $status->ok ? '1' : '0';
1423
1424         if (!$status->ok) {
1425                 $resp .= add_count("renew_all/renewed_count"  , 0);
1426                 $resp .= add_count("renew_all/unrenewed_count", 0);
1427                 @renewed = ();
1428                 @unrenewed = ();
1429         } else {
1430                 @renewed   = (@{$status->renewed});
1431                 @unrenewed = (@{$status->unrenewed});
1432                 $resp .= add_count("renew_all/renewed_count"  , scalar @renewed  );
1433                 $resp .= add_count("renew_all/unrenewed_count", scalar @unrenewed);
1434         }
1435
1436     $resp .= Sip::timestamp;
1437     $resp .= add_field(FID_INST_ID, $ils->institution);
1438
1439     $resp .= join('', map(add_field(FID_RENEWED_ITEMS  , $_), @renewed  ));
1440     $resp .= join('', map(add_field(FID_UNRENEWED_ITEMS, $_), @unrenewed));
1441
1442     $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1443     $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1444
1445     $self->write_msg($resp);
1446
1447     return(RENEW_ALL);
1448 }
1449
1450 #
1451 # send_acs_status($self, $server)
1452 #
1453 # Send an ACS Status message, which is contains lots of little fields
1454 # of information gleaned from all sorts of places.
1455 #
1456
1457 my @message_type_names = (
1458                           "patron status request",
1459                           "checkout",
1460                           "checkin",
1461                           "block patron",
1462                           "acs status",
1463                           "request sc/acs resend",
1464                           "login",
1465                           "patron information",
1466                           "end patron session",
1467                           "fee paid",
1468                           "item information",
1469                           "item status update",
1470                           "patron enable",
1471                           "hold",
1472                           "renew",
1473                           "renew all",
1474                          );
1475
1476 sub send_acs_status {
1477     my ($self, $server, $screen_msg, $print_line) = @_;
1478     my $msg = ACS_STATUS;
1479         ($server) or die "send_acs_status error: no \$server argument received";
1480     my $account = $server->{account} or die "send_acs_status error: no 'account' in \$server object:\n" . Dumper($server);
1481     my $policy  = $server->{policy}  or die "send_acs_status error: no 'policy' in \$server object:\n" . Dumper($server);
1482     my $ils     = $server->{ils}     or die "send_acs_status error: no 'ils' in \$server object:\n" . Dumper($server);
1483     my ($online_status, $checkin_ok, $checkout_ok, $ACS_renewal_policy);
1484     my ($status_update_ok, $offline_ok, $timeout, $retries);
1485
1486     $online_status = 'Y';
1487     $checkout_ok = sipbool($ils->checkout_ok);
1488     $checkin_ok  = sipbool($ils->checkin_ok);
1489     $ACS_renewal_policy = sipbool($policy->{renewal});
1490     $status_update_ok   = sipbool($ils->status_update_ok);
1491     $offline_ok = sipbool($ils->offline_ok);
1492     $timeout = sprintf("%03d", $policy->{timeout});
1493     $retries = sprintf("%03d", $policy->{retries});
1494
1495     if (length($timeout) != 3) {
1496         syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'",
1497                $timeout);
1498         $timeout = '000';
1499     }
1500
1501     if (length($retries) != 3) {
1502         syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'",
1503                $retries);
1504         $retries = '000';
1505     }
1506
1507     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1508     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1509     $msg .= Sip::timestamp();
1510
1511     if ($protocol_version == 1) {
1512         $msg .= '1.00';
1513     } elsif ($protocol_version == 2) {
1514         $msg .= '2.00';
1515     } else {
1516         syslog("LOG_ERR",
1517                'Bad setting for $protocol_version, "%s" in send_acs_status',
1518                $protocol_version);
1519         $msg .= '1.00';
1520     }
1521
1522     # Institution ID
1523     $msg .= add_field(FID_INST_ID, $account->{institution});
1524
1525     if ($protocol_version >= 2) {
1526         # Supported messages: we do it all
1527         my $supported_msgs = '';
1528
1529         foreach my $msg_name (@message_type_names) {
1530             if ($msg_name eq 'request sc/acs resend') {
1531                 $supported_msgs .= Sip::sipbool(1);
1532             } else {
1533                 $supported_msgs .= Sip::sipbool($ils->supports($msg_name));
1534             }
1535         }
1536         if (length($supported_msgs) < 16) {
1537             syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs);
1538         }
1539         $msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs);
1540     }
1541
1542     $msg .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1543
1544     if (defined($account->{print_width}) && defined($print_line)
1545         && $account->{print_width} < length($print_line)) {
1546         syslog("LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating",
1547                $print_line);
1548         $print_line = substr($print_line, 0, $account->{print_width});
1549     }
1550
1551     $msg .= maybe_add(FID_PRINT_LINE, $print_line);
1552
1553     # Do we want to tell the terminal its location?
1554
1555     $self->write_msg($msg);
1556     return 1;
1557 }
1558
1559 #
1560 # build_patron_status: create the 14-char patron status
1561 # string for the Patron Status message
1562 #
1563 sub patron_status_string {
1564     my $patron = shift;
1565     my $patron_status;
1566
1567     syslog("LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok);
1568     $patron_status = sprintf(
1569         '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1570         denied($patron->charge_ok),
1571         denied($patron->renew_ok),
1572         denied($patron->recall_ok),
1573         denied($patron->hold_ok),
1574         boolspace($patron->card_lost),
1575         boolspace($patron->too_many_charged),
1576         boolspace($patron->too_many_overdue),
1577         boolspace($patron->too_many_renewal),
1578         boolspace($patron->too_many_claim_return),
1579         boolspace($patron->too_many_lost),
1580         boolspace($patron->excessive_fines),
1581         boolspace($patron->excessive_fees),
1582         boolspace($patron->recall_overdue),
1583         boolspace($patron->too_many_billed)
1584     );
1585     return $patron_status;
1586 }
1587
1588 sub api_auth($$) {
1589         # AUTH
1590         my ($username,$password) = (shift,shift);
1591         $ENV{REMOTE_USER} = $username;
1592         my $query = CGI->new();
1593         $query->param(userid   => $username);
1594         $query->param(password => $password);
1595         my ($status, $cookie, $sessionID) = check_api_auth($query, {circulate=>1}, "intranet");
1596         # print STDERR "check_api_auth returns " . ($status || 'undef') . "\n";
1597         # print "api_auth userenv = " . &dump_userenv;
1598         return $status;
1599 }
1600
1601 1;
1602 __END__
1603