C4/SIP/Sip/MsgType.pm

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