C4/SIP/Sip/MsgType.pm

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