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