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