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