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