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