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