C4/SIP/Sip/MsgType.pm

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