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