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