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         $patron->update_lastseen();
 940         $resp .= patron_status_string($patron);
 941         $resp .= ( defined($lang) and length($lang) == 3 ) ? $lang : $patron->language;
 942         $resp .= timestamp();
 943
 944         $resp .= add_count( 'patron_info/hold_items',    scalar @{ $patron->hold_items } );
 945         $resp .= add_count( 'patron_info/overdue_items', scalar @{ $patron->overdue_items } );
 946         $resp .= add_count( 'patron_info/charged_items', scalar @{ $patron->charged_items } );
 947         $resp .= add_count( 'patron_info/fine_items',    scalar @{ $patron->fine_items } );
 948         $resp .= add_count( 'patron_info/recall_items',  scalar @{ $patron->recall_items } );
 949         $resp .= add_count( 'patron_info/unavail_holds', scalar @{ $patron->unavail_holds } );
 950
 951         $resp .= add_field( FID_INST_ID, ( $ils->institution_id || 'SIP2' ) );
 952
 953         # while the patron ID we got from the SC is valid, let's
 954         # use the one returned from the ILS, just in case...
 955         $resp .= add_field( FID_PATRON_ID,     $patron->id );
 956         $resp .= add_field( FID_PERSONAL_NAME, $patron->name( $server->{account}->{ae_field_template} ) );
 957
 958         # TODO: add code for the fields
 959         #   hold items limit
 960         #   overdue items limit
 961         #   charged items limit
 962
 963         $resp .= add_field( FID_VALID_PATRON, 'Y' );
 964         my $password_rc;
 965         if ( defined($patron_pwd) ) {
 966
 967             # If patron password was provided, report whether it was right or not.
 968             $password_rc = $patron->check_password($patron_pwd);
 969             if ( $patron_pwd eq q{} && $server->{account}->{allow_empty_passwords} ) {
 970                 $password_rc = 1;
 971             }
 972             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $password_rc ) );
 973         }
 974
 975         $resp .= maybe_add( FID_CURRENCY, $patron->currency );
 976         $resp .= maybe_add( FID_FEE_AMT,  $patron->fee_amount );
 977         $resp .= add_field( FID_FEE_LMT, $patron->fee_limit );
 978
 979         # TODO: zero or more item details for 2.0 can go here:
 980         #          hold_items
 981         #       overdue_items
 982         #       charged_items
 983         #          fine_items
 984         #        recall_items
 985
 986         $resp .= summary_info( $ils, $patron, $summary, $start, $end, $server );
 987
 988         $resp .= maybe_add( FID_HOME_ADDR,  $patron->address );
 989         $resp .= maybe_add( FID_EMAIL,      $patron->email_addr );
 990         $resp .= maybe_add( FID_HOME_PHONE, $patron->home_phone );
 991
 992         # SIP 2.0 extensions used by Envisionware
 993         # Other terminals will ignore unrecognized fields (unrecognized field identifiers)
 994         $resp .= maybe_add( FID_PATRON_BIRTHDATE, $patron->birthdate );
 995         $resp .= maybe_add( FID_PATRON_CLASS,     $patron->ptype );
 996
 997         # Custom protocol extension to report patron internet privileges
 998         $resp .= maybe_add( FID_INET_PROFILE, $patron->inet_privileges );
 999
1000         my $msg = $patron->screen_msg;
1001         if( defined( $patron_pwd ) && !$password_rc ) {
1002             $msg .= ' -- ' . INVALID_PW;
1003         }
1004         $resp .= maybe_add( FID_SCREEN_MSG, $msg, $server );
1005         if ( $server->{account}->{send_patron_home_library_in_af} ) {
1006             $resp .= maybe_add( FID_SCREEN_MSG, $patron->{branchcode}, $server);
1007         }
1008         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line );
1009
1010         $resp .= $patron->build_patron_attributes_string( $server );
1011     } else {
1012
1013         # Invalid patron ID:
1014         # no privileges, no items associated,
1015         # no personal name, and is invalid (if we're using 2.00)
1016         $resp .= 'YYYY' . ( ' ' x 10 ) . $lang . timestamp();
1017         $resp .= '0000' x 6;
1018
1019         $resp .= add_field( FID_INST_ID, ( $ils->institution_id || 'SIP2' ) );
1020
1021         # patron ID is invalid, but field is required, so just echo it back
1022         $resp .= add_field( FID_PATRON_ID, $fields->{ (FID_PATRON_ID) } );
1023         $resp .= add_field( FID_PERSONAL_NAME, '' );
1024
1025         if ( $protocol_version >= 2 ) {
1026             $resp .= add_field( FID_VALID_PATRON, 'N' );
1027         }
1028         $resp .= maybe_add( FID_SCREEN_MSG, INVALID_CARD, $server );
1029     }
1030
1031     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1032     return (PATRON_INFO);
1033 }
1034
1035 sub handle_end_patron_session {
1036     my ( $self, $server ) = @_;
1037     my $ils = $server->{ils};
1038     my $trans_date;
1039     my $fields = $self->{fields};
1040     my $resp   = END_SESSION_RESP;
1041     my ( $status, $screen_msg, $print_line );
1042
1043     ($trans_date) = @{ $self->{fixed_fields} };
1044
1045     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, 'handle_end_patron_session' );
1046
1047     ( $status, $screen_msg, $print_line ) = $ils->end_patron_session( $fields->{ (FID_PATRON_ID) } );
1048
1049     $resp .= $status ? 'Y' : 'N';
1050     $resp .= timestamp();
1051
1052     $resp .= add_field( FID_INST_ID, $server->{ils}->institution );
1053     $resp .= add_field( FID_PATRON_ID, $fields->{ (FID_PATRON_ID) } );
1054
1055     $resp .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server );
1056     $resp .= maybe_add( FID_PRINT_LINE, $print_line );
1057
1058     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1059
1060     return (END_PATRON_SESSION);
1061 }
1062
1063 sub handle_fee_paid {
1064     my ( $self, $server ) = @_;
1065     my $ils = $server->{ils};
1066     my ( $trans_date, $fee_type, $pay_type, $currency ) = @{ $self->{fixed_fields} };
1067     my $fields = $self->{fields};
1068     my ( $fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd );
1069     my ( $fee_id, $trans_id );
1070     my $status;
1071     my $resp = FEE_PAID_RESP;
1072
1073     my $disallow_overpayment  = $server->{account}->{disallow_overpayment};
1074     my $payment_type_writeoff = $server->{account}->{payment_type_writeoff} || q{};
1075
1076     my $is_writeoff = $pay_type eq $payment_type_writeoff;
1077
1078     $fee_amt    = $fields->{ (FID_FEE_AMT) };
1079     $inst_id    = $fields->{ (FID_INST_ID) };
1080     $patron_id  = $fields->{ (FID_PATRON_ID) };
1081     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1082     $fee_id     = $fields->{ (FID_FEE_ID) };
1083     $trans_id   = $fields->{ (FID_TRANSACTION_ID) };
1084
1085     $ils->check_inst_id( $inst_id, "handle_fee_paid" );
1086
1087     $status = $ils->pay_fee( $patron_id, $patron_pwd, $fee_amt, $fee_type, $pay_type, $fee_id, $trans_id, $currency, $is_writeoff, $disallow_overpayment );
1088
1089     $resp .= ( $status->ok ? 'Y' : 'N' ) . timestamp;
1090     $resp .= add_field( FID_INST_ID,   $inst_id );
1091     $resp .= add_field( FID_PATRON_ID, $patron_id );
1092     $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id );
1093     $resp .= maybe_add( FID_SCREEN_MSG,     $status->screen_msg, $server );
1094     $resp .= maybe_add( FID_PRINT_LINE,     $status->print_line );
1095
1096     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1097
1098     return (FEE_PAID);
1099 }
1100
1101 sub handle_item_information {
1102     my ( $self, $server ) = @_;
1103     my $ils = $server->{ils};
1104     my $trans_date;
1105     my $fields = $self->{fields};
1106     my $resp   = ITEM_INFO_RESP;
1107     my $item;
1108     my $i;
1109
1110     ($trans_date) = @{ $self->{fixed_fields} };
1111
1112     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_item_information" );
1113
1114     $item = $ils->find_item( $fields->{ (FID_ITEM_ID) } );
1115
1116     if ( !defined($item) ) {
1117
1118         # Invalid Item ID
1119         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1120         $resp .= "010101";
1121         $resp .= timestamp;
1122
1123         # Just echo back the invalid item id
1124         $resp .= add_field( FID_ITEM_ID, $fields->{ (FID_ITEM_ID) } );
1125
1126         # title id is required, but we don't have one
1127         $resp .= add_field( FID_TITLE_ID, '' );
1128     } else {
1129
1130         # Valid Item ID, send the good stuff
1131         $resp .= $item->sip_circulation_status;
1132         $resp .= $item->sip_security_marker;
1133         $resp .= $item->sip_fee_type;
1134         $resp .= timestamp;
1135
1136         $resp .= add_field( FID_ITEM_ID,  $item->id );
1137         $resp .= add_field( FID_TITLE_ID, $item->title_id );
1138
1139         $resp .= maybe_add( FID_MEDIA_TYPE,   $item->sip_media_type );
1140         $resp .= maybe_add( FID_PERM_LOCN,    $item->permanent_location );
1141         $resp .= maybe_add( FID_CURRENT_LOCN, $item->current_location );
1142         $resp .= maybe_add( FID_ITEM_PROPS,   $item->sip_item_properties );
1143
1144         if ( ( $i = $item->fee ) != 0 ) {
1145             $resp .= add_field( FID_CURRENCY, $item->fee_currency );
1146             $resp .= add_field( FID_FEE_AMT,  $i );
1147         }
1148         $resp .= maybe_add( FID_OWNER, $item->owner );
1149
1150         if ( ( $i = scalar @{ $item->hold_queue } ) > 0 ) {
1151             $resp .= add_field( FID_HOLD_QUEUE_LEN, $i );
1152         }
1153         if ( $item->due_date ) {
1154             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ) );
1155         }
1156         if ( ( $i = $item->recall_date ) != 0 ) {
1157             $resp .= add_field( FID_RECALL_DATE, timestamp($i) );
1158         }
1159         if ( ( $i = $item->hold_pickup_date ) != 0 ) {
1160             $resp .= add_field( FID_HOLD_PICKUP_DATE, timestamp($i) );
1161         }
1162
1163         $resp .= maybe_add( FID_SCREEN_MSG, $item->screen_msg, $server );
1164         $resp .= maybe_add( FID_PRINT_LINE, $item->print_line );
1165     }
1166
1167     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1168
1169     return (ITEM_INFORMATION);
1170 }
1171
1172 sub handle_item_status_update {
1173     my ( $self, $server ) = @_;
1174     my $ils = $server->{ils};
1175     my ( $trans_date, $item_id, $terminal_pwd, $item_props );
1176     my $fields = $self->{fields};
1177     my $status;
1178     my $item;
1179     my $resp = ITEM_STATUS_UPDATE_RESP;
1180
1181     ($trans_date) = @{ $self->{fixed_fields} };
1182
1183     $ils->check_inst_id( $fields->{ (FID_INST_ID) } );
1184
1185     $item_id    = $fields->{ (FID_ITEM_ID) };
1186     $item_props = $fields->{ (FID_ITEM_PROPS) };
1187
1188     if ( !defined($item_id) ) {
1189         syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1190     } else {
1191         $item = $ils->find_item($item_id);
1192     }
1193
1194     if ( !$item ) {
1195
1196         # Invalid Item ID
1197         $resp .= '0';
1198         $resp .= timestamp;
1199         $resp .= add_field( FID_ITEM_ID, $item_id );
1200     } else {
1201
1202         # Valid Item ID
1203
1204         $status = $item->status_update($item_props);
1205
1206         $resp .= $status->ok ? '1' : '0';
1207         $resp .= timestamp;
1208
1209         $resp .= add_field( FID_ITEM_ID,  $item->id );
1210         $resp .= add_field( FID_TITLE_ID, $item->title_id );
1211         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties );
1212     }
1213
1214     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1215     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
1216
1217     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1218
1219     return (ITEM_STATUS_UPDATE);
1220 }
1221
1222 sub handle_patron_enable {
1223     my ( $self, $server ) = @_;
1224     my $ils    = $server->{ils};
1225     my $fields = $self->{fields};
1226     my ( $trans_date, $patron_id, $terminal_pwd, $patron_pwd );
1227     my ( $status, $patron );
1228     my $resp = PATRON_ENABLE_RESP;
1229
1230     ($trans_date) = @{ $self->{fixed_fields} };
1231     $patron_id  = $fields->{ (FID_PATRON_ID) };
1232     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1233
1234     syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1235
1236     $patron = $ils->find_patron($patron_id);
1237
1238     if ( !defined($patron) ) {
1239
1240         # Invalid patron ID
1241         $resp .= 'YYYY' . ( ' ' x 10 ) . '000' . timestamp();
1242         $resp .= add_field( FID_PATRON_ID,        $patron_id );
1243         $resp .= add_field( FID_PERSONAL_NAME,    '' );
1244         $resp .= add_field( FID_VALID_PATRON,     'N' );
1245         $resp .= add_field( FID_VALID_PATRON_PWD, 'N' );
1246     } else {
1247
1248         # valid patron
1249         if ( !defined($patron_pwd) || $patron->check_password($patron_pwd) ) {
1250
1251             # Don't enable the patron if there was an invalid password
1252             $status = $patron->enable;
1253         }
1254         $resp .= patron_status_string($patron);
1255         $resp .= $patron->language . timestamp();
1256
1257         $resp .= add_field( FID_PATRON_ID,     $patron->id );
1258         $resp .= add_field( FID_PERSONAL_NAME, $patron->name( $server->{account}->{ae_field_template} ) );
1259         if ( defined($patron_pwd) ) {
1260             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $patron->check_password($patron_pwd) ) );
1261         }
1262         $resp .= add_field( FID_VALID_PATRON, 'Y' );
1263         $resp .= maybe_add( FID_SCREEN_MSG, $patron->screen_msg, $server );
1264         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line );
1265     }
1266
1267     $resp .= add_field( FID_INST_ID, $ils->institution );
1268
1269     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1270
1271     return (PATRON_ENABLE);
1272 }
1273
1274 sub handle_hold {
1275     my ( $self, $server ) = @_;
1276     my $ils = $server->{ils};
1277     my ( $hold_mode, $trans_date );
1278     my ( $expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd );
1279     my ( $item_id, $title_id, $fee_ack );
1280     my $fields = $self->{fields};
1281     my $status;
1282     my $resp = HOLD_RESP;
1283
1284     ( $hold_mode, $trans_date ) = @{ $self->{fixed_fields} };
1285
1286     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_hold" );
1287
1288     $patron_id   = $fields->{ (FID_PATRON_ID) };
1289     $expiry_date = $fields->{ (FID_EXPIRATION) } || '';
1290     $pickup_locn = $fields->{ (FID_PICKUP_LOCN) } || '';
1291     $hold_type   = $fields->{ (FID_HOLD_TYPE) } || '2';    # Any copy of title
1292     $patron_pwd  = $fields->{ (FID_PATRON_PWD) };
1293     $item_id     = $fields->{ (FID_ITEM_ID) } || '';
1294     $title_id    = $fields->{ (FID_TITLE_ID) } || '';
1295     $fee_ack     = $fields->{ (FID_FEE_ACK) } || 'N';
1296
1297     if ( $hold_mode eq '+' ) {
1298         $status = $ils->add_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1299     } elsif ( $hold_mode eq '-' ) {
1300         $status = $ils->cancel_hold( $patron_id, $patron_pwd, $item_id, $title_id );
1301     } elsif ( $hold_mode eq '*' ) {
1302         $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1303     } else {
1304         syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1305         $status = $ils->Transaction::Hold;    # new?
1306         $status->screen_msg("System error. Please contact library staff.");
1307     }
1308
1309     $resp .= $status->ok;
1310     $resp .= sipbool( $status->item && $status->item->available($patron_id) );
1311     $resp .= timestamp;
1312
1313     if ( $status->ok ) {
1314         $resp .= add_field( FID_PATRON_ID, $status->patron->id );
1315
1316         ( $status->expiration_date )
1317           and $resp .= maybe_add( FID_EXPIRATION, timestamp( $status->expiration_date ) );
1318         $resp .= maybe_add( FID_QUEUE_POS,   $status->queue_position );
1319         $resp .= maybe_add( FID_PICKUP_LOCN, $status->pickup_location );
1320         $resp .= maybe_add( FID_ITEM_ID,     $status->item->id );
1321         $resp .= maybe_add( FID_TITLE_ID,    $status->item->title_id );
1322     } else {
1323
1324         # Not ok.  still need required fields
1325         $resp .= add_field( FID_PATRON_ID, $patron_id );
1326     }
1327
1328     $resp .= add_field( FID_INST_ID, $ils->institution );
1329     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1330     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
1331
1332     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1333
1334     return (HOLD);
1335 }
1336
1337 sub handle_renew {
1338     my ( $self, $server ) = @_;
1339     my $ils = $server->{ils};
1340     my ( $third_party, $no_block, $trans_date, $nb_due_date );
1341     my ( $patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack );
1342     my $fields = $self->{fields};
1343     my $status;
1344     my ( $patron, $item );
1345     my $resp = RENEW_RESP;
1346
1347     ( $third_party, $no_block, $trans_date, $nb_due_date ) = @{ $self->{fixed_fields} };
1348
1349     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1350
1351     if ( $no_block eq 'Y' ) {
1352         syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1353     }
1354
1355     $patron_id  = $fields->{ (FID_PATRON_ID) };
1356     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1357     $item_id    = $fields->{ (FID_ITEM_ID) };
1358     $title_id   = $fields->{ (FID_TITLE_ID) };
1359     $item_props = $fields->{ (FID_ITEM_PROPS) };
1360     $fee_ack    = $fields->{ (FID_FEE_ACK) };
1361
1362     $status = $ils->renew( $patron_id, $patron_pwd, $item_id, $title_id, $no_block, $nb_due_date, $third_party, $item_props, $fee_ack );
1363
1364     $patron = $status->patron;
1365     $item   = $status->item;
1366
1367     if ( $status->renewal_ok ) {
1368         $resp .= '1';
1369         $resp .= $status->renewal_ok ? 'Y' : 'N';
1370         if ( $ils->supports('magnetic media') ) {
1371             $resp .= sipbool( $item->magnetic_media );
1372         } else {
1373             $resp .= 'U';
1374         }
1375         $resp .= sipbool( $status->desensitize );
1376         $resp .= timestamp;
1377         $resp .= add_field( FID_PATRON_ID, $patron->id );
1378         $resp .= add_field( FID_ITEM_ID, $item->id );
1379         $resp .= add_field( FID_TITLE_ID, $item->title_id );
1380         if ( $item->due_date ) {
1381             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ) );
1382         } else {
1383             $resp .= add_field( FID_DUE_DATE, q{} );
1384         }
1385         if ( $ils->supports('security inhibit') ) {
1386             $resp .= add_field( FID_SECURITY_INHIBIT, $status->security_inhibit );
1387         }
1388         $resp .= add_field( FID_MEDIA_TYPE, $item->sip_media_type );
1389         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties );
1390     } else {
1391
1392         # renew failed for some reason
1393         # not OK, renewal not OK, Unknown media type (why bother checking?)
1394         $resp .= '0NUN';
1395         $resp .= timestamp;
1396
1397         # If we found the patron or the item, the return the ILS
1398         # information, otherwise echo back the information we received
1399         # from the terminal
1400         $resp .= add_field( FID_PATRON_ID, $patron ? $patron->id     : $patron_id );
1401         $resp .= add_field( FID_ITEM_ID,   $item   ? $item->id       : $item_id );
1402         $resp .= add_field( FID_TITLE_ID,  $item   ? $item->title_id : $title_id );
1403         $resp .= add_field( FID_DUE_DATE,  '' );
1404     }
1405
1406     if ( $status->fee_amount ) {
1407         $resp .= add_field( FID_FEE_AMT, $status->fee_amount );
1408         $resp .= maybe_add( FID_CURRENCY,       $status->sip_currency );
1409         $resp .= maybe_add( FID_FEE_TYPE,       $status->sip_fee_type );
1410         $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id );
1411     }
1412
1413     $resp .= add_field( FID_INST_ID, $ils->institution );
1414     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1415     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
1416
1417     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1418
1419     return (RENEW);
1420 }
1421
1422 sub handle_renew_all {
1423
1424     # my ($third_party, $no_block, $nb_due_date, $fee_ack, $patron);
1425
1426     my ( $self, $server ) = @_;
1427     my $ils = $server->{ils};
1428     my ( $trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack );
1429     my $fields = $self->{fields};
1430     my $resp   = RENEW_ALL_RESP;
1431     my $status;
1432     my ( @renewed, @unrenewed );
1433
1434     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew_all" );
1435
1436     ($trans_date) = @{ $self->{fixed_fields} };
1437
1438     $patron_id    = $fields->{ (FID_PATRON_ID) };
1439     $patron_pwd   = $fields->{ (FID_PATRON_PWD) };
1440     $terminal_pwd = $fields->{ (FID_TERMINAL_PWD) };
1441     $fee_ack      = $fields->{ (FID_FEE_ACK) };
1442
1443     $status = $ils->renew_all( $patron_id, $patron_pwd, $fee_ack );
1444
1445     $resp .= $status->ok ? '1' : '0';
1446
1447     if ( !$status->ok ) {
1448         $resp .= add_count( "renew_all/renewed_count",   0 );
1449         $resp .= add_count( "renew_all/unrenewed_count", 0 );
1450         @renewed   = ();
1451         @unrenewed = ();
1452     } else {
1453         @renewed   = ( @{ $status->renewed } );
1454         @unrenewed = ( @{ $status->unrenewed } );
1455         $resp .= add_count( "renew_all/renewed_count",   scalar @renewed );
1456         $resp .= add_count( "renew_all/unrenewed_count", scalar @unrenewed );
1457     }
1458
1459     $resp .= timestamp;
1460     $resp .= add_field( FID_INST_ID, $ils->institution );
1461
1462     $resp .= join( '', map( add_field( FID_RENEWED_ITEMS,   $_ ), @renewed ) );
1463     $resp .= join( '', map( add_field( FID_UNRENEWED_ITEMS, $_ ), @unrenewed ) );
1464
1465     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1466     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
1467
1468     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1469
1470     return (RENEW_ALL);
1471 }
1472
1473 #
1474 # send_acs_status($self, $server)
1475 #
1476 # Send an ACS Status message, which is contains lots of little fields
1477 # of information gleaned from all sorts of places.
1478 #
1479
1480 my @message_type_names = (
1481     "patron status request",
1482     "checkout",
1483     "checkin",
1484     "block patron",
1485     "acs status",
1486     "request sc/acs resend",
1487     "login",
1488     "patron information",
1489     "end patron session",
1490     "fee paid",
1491     "item information",
1492     "item status update",
1493     "patron enable",
1494     "hold",
1495     "renew",
1496     "renew all",
1497 );
1498
1499 sub send_acs_status {
1500     my ( $self, $server, $screen_msg, $print_line ) = @_;
1501     my $msg = ACS_STATUS;
1502     ($server) or die "send_acs_status error: no \$server argument received";
1503     my $account = $server->{account} or die "send_acs_status error: no 'account' in \$server object:\n" . Dumper($server);
1504     my $policy  = $server->{policy}  or die "send_acs_status error: no 'policy' in \$server object:\n" . Dumper($server);
1505     my $ils     = $server->{ils}     or die "send_acs_status error: no 'ils' in \$server object:\n" . Dumper($server);
1506     my ( $online_status,    $checkin_ok, $checkout_ok, $ACS_renewal_policy );
1507     my ( $status_update_ok, $offline_ok, $timeout,     $retries );
1508
1509     $online_status      = 'Y';
1510     $checkout_ok        = sipbool( $ils->checkout_ok );
1511     $checkin_ok         = sipbool( $ils->checkin_ok );
1512     $ACS_renewal_policy = sipbool( $policy->{renewal} );
1513     $status_update_ok   = sipbool( $ils->status_update_ok );
1514     $offline_ok         = sipbool( $ils->offline_ok );
1515     $timeout            = $server->get_timeout({ policy => 1 });
1516     $retries            = sprintf( "%03d", $policy->{retries} );
1517
1518     if ( length($retries) != 3 ) {
1519         syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1520         $retries = '000';
1521     }
1522
1523     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1524     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1525     $msg .= timestamp();
1526
1527     if ( $protocol_version == 1 ) {
1528         $msg .= '1.00';
1529     } elsif ( $protocol_version == 2 ) {
1530         $msg .= '2.00';
1531     } else {
1532         syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1533         $msg .= '1.00';
1534     }
1535
1536     # Institution ID
1537     $msg .= add_field( FID_INST_ID, $account->{institution} );
1538
1539     if ( $protocol_version >= 2 ) {
1540
1541         # Supported messages: we do it all
1542         my $supported_msgs = '';
1543
1544         foreach my $msg_name (@message_type_names) {
1545             if ( $msg_name eq 'request sc/acs resend' ) {
1546                 $supported_msgs .= sipbool(1);
1547             } else {
1548                 $supported_msgs .= sipbool( $ils->supports($msg_name) );
1549             }
1550         }
1551         if ( length($supported_msgs) < 16 ) {
1552             syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1553         }
1554         $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs );
1555     }
1556
1557     $msg .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server );
1558
1559     if (   defined( $account->{print_width} )
1560         && defined($print_line)
1561         && $account->{print_width} < length($print_line) ) {
1562         syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1563         $print_line = substr( $print_line, 0, $account->{print_width} );
1564     }
1565
1566     $msg .= maybe_add( FID_PRINT_LINE, $print_line );
1567
1568     # Do we want to tell the terminal its location?
1569
1570     $self->write_msg( $msg, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1571     return 1;
1572 }
1573
1574 #
1575 # build_patron_status: create the 14-char patron status
1576 # string for the Patron Status message
1577 #
1578 sub patron_status_string {
1579     my $patron = shift;
1580     my $patron_status;
1581
1582     syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1583     $patron_status = sprintf(
1584         '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1585         denied( $patron->charge_ok ),
1586         denied( $patron->renew_ok ),
1587         denied( $patron->recall_ok ),
1588         denied( $patron->hold_ok ),
1589         boolspace( $patron->card_lost ),
1590         boolspace( $patron->too_many_charged ),
1591         boolspace( $patron->too_many_overdue ),
1592         boolspace( $patron->too_many_renewal ),
1593         boolspace( $patron->too_many_claim_return ),
1594         boolspace( $patron->too_many_lost ),
1595         boolspace( $patron->excessive_fines ),
1596         boolspace( $patron->excessive_fees ),
1597         boolspace( $patron->recall_overdue ),
1598         boolspace( $patron->too_many_billed )
1599     );
1600     return $patron_status;
1601 }
1602
1603 sub api_auth {
1604     my ( $username, $password, $branch ) = @_;
1605     $ENV{REMOTE_USER} = $username;
1606     my $query = CGI->new();
1607     $query->param( userid   => $username );
1608     $query->param( password => $password );
1609     if ($branch) {
1610         $query->param( branch => $branch );
1611     }
1612     my ( $status, $cookie, $sessionID ) = check_api_auth( $query, { circulate => 1 }, 'intranet' );
1613     return $status;
1614 }
1615
1616 1;
1617 __END__
1618