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