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( $server->{account}->{ae_field_template} ) );
 424
 425         # while the patron ID we got from the SC is valid, let's
 426         # use the one returned from the ILS, just in case...
 427         $resp .= add_field( FID_PATRON_ID, $patron->id );
 428
 429         if ( $protocol_version >= 2 ) {
 430             $resp .= add_field( FID_VALID_PATRON, 'Y' );
 431
 432             # Patron password is a required field.
 433             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool($password_rc) );
 434             $resp .= maybe_add( FID_CURRENCY, $patron->currency );
 435             $resp .= maybe_add( FID_FEE_AMT,  $patron->fee_amount );
 436         }
 437
 438         my $msg = $patron->screen_msg;
 439         $msg .= ' -- '. INVALID_PW if $patron_pwd && !$password_rc;
 440         $resp .= maybe_add( FID_SCREEN_MSG, $msg, $server );
 441
 442         $resp .= maybe_add( FID_SCREEN_MSG, $patron->{branchcode}, $server )
 443           if ( $server->{account}->{send_patron_home_library_in_af} );
 444         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line );
 445
 446     } else {
 447         # Invalid patron (cardnumber)
 448         # Report that the user has no privs.
 449
 450         # no personal name, and is invalid (if we're using 2.00)
 451         $resp .= 'YYYY' . ( ' ' x 10 ) . $lang . timestamp();
 452         $resp .= add_field( FID_PERSONAL_NAME, '' );
 453
 454         # the patron ID is invalid, but it's a required field, so
 455         # just echo it back
 456         $resp .= add_field( FID_PATRON_ID, $fields->{ (FID_PATRON_ID) } );
 457
 458         ( $protocol_version >= 2 )
 459           and $resp .= add_field( FID_VALID_PATRON, 'N' );
 460
 461         $resp .= maybe_add( FID_SCREEN_MSG, INVALID_CARD, $server );
 462     }
 463
 464     $resp .= add_field( FID_INST_ID, $fields->{ (FID_INST_ID) } );
 465     return $resp;
 466 }
 467
 468 sub handle_patron_status {
 469     my ( $self, $server ) = @_;
 470     my $ils = $server->{ils};
 471     my $patron;
 472     my $resp    = (PATRON_STATUS_RESP);
 473     my $account = $server->{account};
 474     my ( $lang, $date ) = @{ $self->{fixed_fields} };
 475     my $fields = $self->{fields};
 476
 477     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_patron_status" );
 478     $patron = $ils->find_patron( $fields->{ (FID_PATRON_ID) } );
 479     $resp = build_patron_status( $patron, $lang, $fields, $server );
 480     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 481     return (PATRON_STATUS_REQ);
 482 }
 483
 484 sub handle_checkout {
 485     my ( $self, $server ) = @_;
 486     my $account = $server->{account};
 487     my $ils     = $server->{ils};
 488     my $inst    = $ils->institution;
 489     my ( $sc_renewal_policy, $no_block, $trans_date, $nb_due_date );
 490     my $fields;
 491     my ( $patron_id, $item_id, $status );
 492     my ( $item, $patron );
 493     my $resp;
 494
 495     ( $sc_renewal_policy, $no_block, $trans_date, $nb_due_date ) = @{ $self->{fixed_fields} };
 496     $fields = $self->{fields};
 497
 498     $patron_id = $fields->{ (FID_PATRON_ID) };
 499     $item_id   = $fields->{ (FID_ITEM_ID) };
 500     my $fee_ack = $fields->{ (FID_FEE_ACK) };
 501
 502     if ( $no_block eq 'Y' ) {
 503
 504         # Off-line transactions need to be recorded, but there's
 505         # not a lot we can do about it
 506         syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} );
 507
 508         $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date );
 509     } else {
 510
 511         # Does the transaction date really matter for items that are
 512         # checkout out while the terminal is online?  I'm guessing 'no'
 513         $status = $ils->checkout( $patron_id, $item_id, $sc_renewal_policy, $fee_ack );
 514     }
 515
 516     $item   = $status->item;
 517     $patron = $status->patron;
 518
 519     if ( $status->ok ) {
 520
 521         # Item successfully checked out
 522         # Fixed fields
 523         $resp = CHECKOUT_RESP . '1';
 524         $resp .= sipbool( $status->renew_ok );
 525         if ( $ils->supports('magnetic media') ) {
 526             $resp .= sipbool( $item->magnetic_media );
 527         } else {
 528             $resp .= 'U';
 529         }
 530
 531         # We never return the obsolete 'U' value for 'desensitize'
 532         $resp .= sipbool( $status->desensitize );
 533         $resp .= timestamp;
 534
 535         # Now for the variable fields
 536         $resp .= add_field( FID_INST_ID,   $inst );
 537         $resp .= add_field( FID_PATRON_ID, $patron_id );
 538         $resp .= add_field( FID_ITEM_ID,   $item_id );
 539         $resp .= add_field( FID_TITLE_ID,  $item->title_id );
 540         if ( $item->due_date ) {
 541             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ) );
 542         } else {
 543             $resp .= add_field( FID_DUE_DATE, q{} );
 544         }
 545
 546         $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
 547         $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
 548
 549         if ( $protocol_version >= 2 ) {
 550             if ( $ils->supports('security inhibit') ) {
 551                 $resp .= add_field( FID_SECURITY_INHIBIT, $status->security_inhibit );
 552             }
 553             $resp .= maybe_add( FID_MEDIA_TYPE, $item->sip_media_type );
 554             $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties );
 555
 556         }
 557     }
 558
 559     else {
 560
 561         # Checkout failed
 562         # Checkout Response: not ok, no renewal, don't know mag. media,
 563         # no desensitize
 564         $resp = sprintf( "120NUN%s", timestamp );
 565         $resp .= add_field( FID_INST_ID,   $inst );
 566         $resp .= add_field( FID_PATRON_ID, $patron_id );
 567         $resp .= add_field( FID_ITEM_ID,   $item_id );
 568
 569         # If the item is valid, provide the title, otherwise
 570         # leave it blank
 571         $resp .= add_field( FID_TITLE_ID, $item ? $item->title_id : '' );
 572
 573         # Due date is required.  Since it didn't get checked out,
 574         # it's not due, so leave the date blank
 575         $resp .= add_field( FID_DUE_DATE, '' );
 576
 577         $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
 578         $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
 579
 580         if ( $protocol_version >= 2 ) {
 581
 582             # Is the patron ID valid?
 583             $resp .= add_field( FID_VALID_PATRON, sipbool($patron) );
 584
 585             if ( $patron && exists( $fields->{FID_PATRON_PWD} ) ) {
 586
 587                 # Password provided, so we can tell if it was valid or not
 588                 $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $patron->check_password( $fields->{ (FID_PATRON_PWD) } ) ) );
 589             }
 590         }
 591     }
 592
 593     if ( $protocol_version >= 2 ) {
 594
 595         # Financials : return irrespective of ok status
 596         if ( $status->fee_amount ) {
 597             $resp .= add_field( FID_FEE_AMT, $status->fee_amount );
 598             $resp .= maybe_add( FID_CURRENCY,       $status->sip_currency );
 599             $resp .= maybe_add( FID_FEE_TYPE,       $status->sip_fee_type );
 600             $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id );
 601         }
 602     }
 603
 604     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 605     return (CHECKOUT);
 606 }
 607
 608 sub handle_checkin {
 609     my ( $self, $server ) = @_;
 610     my $account   = $server->{account};
 611     my $ils       = $server->{ils};
 612     my $my_branch = $ils->institution;
 613     my ( $current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel );
 614     my ( $patron, $item, $status );
 615     my $resp = CHECKIN_RESP;
 616     my ( $no_block, $trans_date, $return_date ) = @{ $self->{fixed_fields} };
 617     my $fields = $self->{fields};
 618
 619     $current_loc = $fields->{ (FID_CURRENT_LOCN) };
 620     $inst_id     = $fields->{ (FID_INST_ID) };
 621     $item_id     = $fields->{ (FID_ITEM_ID) };
 622     $item_props  = $fields->{ (FID_ITEM_PROPS) };
 623     $cancel      = $fields->{ (FID_CANCEL) };
 624     if ($current_loc) {
 625         $my_branch = $current_loc;    # most scm do not set $current_loc
 626     }
 627
 628     $ils->check_inst_id( $inst_id, "handle_checkin" );
 629
 630     if ( $no_block eq 'Y' ) {
 631
 632         # Off-line transactions, ick.
 633         syslog( "LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id} );
 634         $status = $ils->checkin_no_block( $item_id, $trans_date, $return_date, $item_props, $cancel );
 635     } else {
 636         $status = $ils->checkin( $item_id, $trans_date, $return_date, $my_branch, $item_props, $cancel, $account->{checked_in_ok} );
 637     }
 638
 639     $patron = $status->patron;
 640     $item   = $status->item;
 641
 642     $resp .= $status->ok          ? '1' : '0';
 643     $resp .= $status->resensitize ? 'Y' : 'N';
 644     if ( $item && $ils->supports('magnetic media') ) {
 645         $resp .= sipbool( $item->magnetic_media );
 646     } else {
 647
 648         # item barcode is invalid or system doesn't support 'magnetic media' indicator
 649         $resp .= 'U';
 650     }
 651
 652     $resp .= $status->alert ? 'Y' : 'N';
 653     $resp .= timestamp;
 654     $resp .= add_field( FID_INST_ID, $inst_id );
 655     $resp .= add_field( FID_ITEM_ID, $item_id );
 656
 657     if ($item) {
 658         $resp .= add_field( FID_PERM_LOCN, $item->permanent_location );
 659         $resp .= maybe_add( FID_TITLE_ID, $item->title_id );
 660     }
 661
 662     if ( $protocol_version >= 2 ) {
 663         $resp .= maybe_add( FID_SORT_BIN, $status->sort_bin );
 664         if ($patron) {
 665             $resp .= add_field( FID_PATRON_ID, $patron->id );
 666         }
 667         if ($item) {
 668             $resp .= maybe_add( FID_MEDIA_TYPE,           $item->sip_media_type );
 669             $resp .= maybe_add( FID_ITEM_PROPS,           $item->sip_item_properties );
 670             $resp .= maybe_add( FID_COLLECTION_CODE,      $item->collection_code );
 671             $resp .= maybe_add( FID_CALL_NUMBER,          $item->call_number );
 672             $resp .= maybe_add( FID_DESTINATION_LOCATION, $item->destination_loc );
 673             $resp .= maybe_add( FID_HOLD_PATRON_ID,       $item->hold_patron_bcode );
 674             $resp .= maybe_add( FID_HOLD_PATRON_NAME,     $item->hold_patron_name( $server->{account}->{da_field_template} ) );
 675             if ( $status->hold and $status->hold->{branchcode} ne $item->destination_loc ) {
 676                 warn 'SIP hold mismatch: $status->hold->{branchcode}=' . $status->hold->{branchcode} . '; $item->destination_loc=' . $item->destination_loc;
 677
 678                 # just me being paranoid.
 679             }
 680         }
 681     }
 682
 683     $resp .= maybe_add( FID_ALERT_TYPE, $status->alert_type ) if $status->alert;
 684     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
 685     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line );
 686
 687     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 688
 689     return (CHECKIN);
 690 }
 691
 692 sub handle_block_patron {
 693     my ( $self, $server ) = @_;
 694     my $account = $server->{account};
 695     my $ils     = $server->{ils};
 696     my ( $card_retained, $trans_date );
 697     my ( $inst_id, $blocked_card_msg, $patron_id, $terminal_pwd );
 698     my ( $fields, $resp, $patron );
 699
 700     ( $card_retained, $trans_date ) = @{ $self->{fixed_fields} };
 701     $fields           = $self->{fields};
 702     $inst_id          = $fields->{ (FID_INST_ID) };
 703     $blocked_card_msg = $fields->{ (FID_BLOCKED_CARD_MSG) };
 704     $patron_id        = $fields->{ (FID_PATRON_ID) };
 705     $terminal_pwd     = $fields->{ (FID_TERMINAL_PWD) };
 706
 707     # Terminal passwords are different from account login
 708     # passwords, but I have no idea what to do with them.  So,
 709     # I'll just ignore them for now.
 710
 711     # FIXME ???
 712
 713     $ils->check_inst_id( $inst_id, "block_patron" );
 714     $patron = $ils->find_patron($patron_id);
 715
 716     # The correct response for a "Block Patron" message is a
 717     # "Patron Status Response", so use that handler to generate
 718     # the message, but then return the correct code from here.
 719     #
 720     # Normally, the language is provided by the "Patron Status"
 721     # fixed field, but since we're not responding to one of those
 722     # we'll just say, "Unspecified", as per the spec.  Let the
 723     # terminal default to something that, one hopes, will be
 724     # intelligible
 725     if ($patron) {
 726
 727         # Valid patron id
 728         $patron->block( $card_retained, $blocked_card_msg );
 729     }
 730
 731     $resp = build_patron_status( $patron, $patron->language, $fields, $server );
 732     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 733     return (BLOCK_PATRON);
 734 }
 735
 736 sub handle_sc_status {
 737     my ( $self, $server ) = @_;
 738     ($server) or warn "handle_sc_status error: no \$server argument received.";
 739     my ( $status, $print_width, $sc_protocol_version ) = @{ $self->{fixed_fields} };
 740     my ($new_proto);
 741
 742     if ( $sc_protocol_version =~ /^1\./ ) {
 743         $new_proto = 1;
 744     } elsif ( $sc_protocol_version =~ /^2\./ ) {
 745         $new_proto = 2;
 746     } else {
 747         syslog( "LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version );
 748         $new_proto = 1;
 749     }
 750
 751     if ( $new_proto != $protocol_version ) {
 752         syslog( "LOG_INFO", "Setting protocol level to $new_proto" );
 753         $protocol_version = $new_proto;
 754     }
 755
 756     if ( $status == SC_STATUS_PAPER ) {
 757         syslog( "LOG_WARNING", "Self-Check unit '%s@%s' out of paper", $self->{account}->{id}, $self->{account}->{institution} );
 758     } elsif ( $status == SC_STATUS_SHUTDOWN ) {
 759         syslog( "LOG_WARNING", "Self-Check unit '%s@%s' shutting down", $self->{account}->{id}, $self->{account}->{institution} );
 760     }
 761
 762     $self->{account}->{print_width} = $print_width;
 763     return ( send_acs_status( $self, $server ) ? SC_STATUS : '' );
 764 }
 765
 766 sub handle_request_acs_resend {
 767     my ( $self, $server ) = @_;
 768
 769     if ( !$last_response ) {
 770
 771         # We haven't sent anything yet, so respond with a
 772         # REQUEST_SC_RESEND msg (p. 16)
 773         $self->write_msg( REQUEST_SC_RESEND, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 774     } elsif ( ( length($last_response) < 9 )
 775         || substr( $last_response, -9, 2 ) ne 'AY' ) {
 776
 777         # When resending a message, we aren't supposed to include
 778         # a sequence number, even if the original had one (p. 4).
 779         # If the last message didn't have a sequence number, then
 780         # we can just send it.
 781         print("$last_response\r");    # not write_msg?
 782     } else {
 783
 784         # Cut out the sequence number and checksum, since the old
 785         # checksum is wrong for the resent message.
 786         my $rebuilt = substr( $last_response, 0, -9 );
 787         $self->write_msg( $rebuilt, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 788     }
 789
 790     return REQUEST_ACS_RESEND;
 791 }
 792
 793 sub login_core {
 794     my $server = shift or return;
 795     my $uid    = shift;
 796     my $pwd    = shift;
 797     my $status = 1;                 # Assume it all works
 798     if ( !exists( $server->{config}->{accounts}->{$uid} ) ) {
 799         syslog( "LOG_WARNING", "MsgType::login_core: Unknown login '$uid'" );
 800         $status = 0;
 801     } elsif ( $server->{config}->{accounts}->{$uid}->{password} ne $pwd ) {
 802         syslog( "LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'" );
 803         $status = 0;
 804     } else {
 805
 806         # Store the active account someplace handy for everybody else to find.
 807         $server->{account} = $server->{config}->{accounts}->{$uid};
 808         my $inst = $server->{account}->{institution};
 809         $server->{institution}  = $server->{config}->{institutions}->{$inst};
 810         $server->{policy}       = $server->{institution}->{policy};
 811         $server->{sip_username} = $uid;
 812         $server->{sip_password} = $pwd;
 813
 814         my $auth_status = api_auth( $uid, $pwd, $inst );
 815         if ( !$auth_status or $auth_status !~ /^ok$/i ) {
 816             syslog( "LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ( $auth_status || 'unknown' ) );
 817             $status = 0;
 818         } else {
 819             syslog( "LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst );
 820
 821             #
 822             # initialize connection to ILS
 823             #
 824             my $module = $server->{config}->{institutions}->{$inst}->{implementation};
 825             syslog( "LOG_DEBUG", 'login_core: ' . Dumper($module) );
 826
 827             # Suspect this is always ILS but so we don't break any eccentic install (for now)
 828             if ( $module eq 'ILS' ) {
 829                 $module = 'C4::SIP::ILS';
 830             }
 831             $module->use;
 832             if ($@) {
 833                 syslog( "LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst );
 834                 die("Failed to load ILS implementation '$module' for $inst");
 835             }
 836
 837             # like   ILS->new(), I think.
 838             $server->{ils} = $module->new( $server->{institution}, $server->{account} );
 839             if ( !$server->{ils} ) {
 840                 syslog( "LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst );
 841                 die("Unable to connect to ILS '$inst'");
 842             }
 843         }
 844     }
 845     return $status;
 846 }
 847
 848 sub handle_login {
 849     my ( $self, $server ) = @_;
 850     my ( $uid_algorithm, $pwd_algorithm );
 851     my ( $uid,           $pwd );
 852     my $inst;
 853     my $fields;
 854     my $status = 1;    # Assume it all works
 855
 856     $fields = $self->{fields};
 857     ( $uid_algorithm, $pwd_algorithm ) = @{ $self->{fixed_fields} };
 858
 859     $uid = $fields->{ (FID_LOGIN_UID) };    # Terminal ID, not patron ID.
 860     $pwd = $fields->{ (FID_LOGIN_PWD) };    # Terminal PWD, not patron PWD.
 861
 862     if ( $uid_algorithm || $pwd_algorithm ) {
 863         syslog( "LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm" );
 864         $status = 0;
 865     } else {
 866         $status = login_core( $server, $uid, $pwd );
 867     }
 868
 869     $self->write_msg( LOGIN_RESP . $status, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
 870     return $status ? LOGIN : '';
 871 }
 872
 873 #
 874 # Build the detailed summary information for the Patron
 875 # Information Response message based on the first 'Y' that appears
 876 # in the 'summary' field of the Patron Information request.  The
 877 # specification says that only one 'Y' can appear in that field,
 878 # and we're going to believe it.
 879 #
 880 sub summary_info {
 881     my ( $ils, $patron, $summary, $start, $end, $server ) = @_;
 882     my $resp = '';
 883     my $summary_type;
 884
 885     #
 886     # Map from offsets in the "summary" field of the Patron Information
 887     # message to the corresponding field and handler
 888     #
 889     my @summary_map = (
 890         { func => $patron->can("hold_items"),    fid => FID_HOLD_ITEMS },
 891         { func => $patron->can("overdue_items"), fid => FID_OVERDUE_ITEMS },
 892         { func => $patron->can("charged_items"), fid => FID_CHARGED_ITEMS },
 893         { func => $patron->can("fine_items"),    fid => FID_FINE_ITEMS },
 894         { func => $patron->can("recall_items"),  fid => FID_RECALL_ITEMS },
 895         { func => $patron->can("unavail_holds"), fid => FID_UNAVAILABLE_HOLD_ITEMS },
 896     );
 897
 898     if ( ( $summary_type = index( $summary, 'Y' ) ) == -1 ) {
 899         return '';    # No detailed information required
 900     }
 901
 902     syslog( "LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid} );
 903
 904     my $func     = $summary_map[$summary_type]->{func};
 905     my $fid      = $summary_map[$summary_type]->{fid};
 906     my $itemlist = &$func( $patron, $start, $end, $server );
 907
 908     syslog( "LOG_DEBUG", "summary_info: list = (%s)", join( ", ", @{$itemlist} ) );
 909     foreach my $i ( @{$itemlist} ) {
 910         $resp .= add_field( $fid, $i->{barcode} );
 911     }
 912
 913     return $resp;
 914 }
 915
 916 sub handle_patron_info {
 917     my ( $self, $server ) = @_;
 918     my $ils = $server->{ils};
 919     my ( $lang, $trans_date, $summary ) = @{ $self->{fixed_fields} };
 920     my $fields = $self->{fields};
 921     my ( $inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end );
 922     my ( $resp, $patron );
 923
 924     $inst_id      = $fields->{ (FID_INST_ID) };
 925     $patron_id    = $fields->{ (FID_PATRON_ID) };
 926     $terminal_pwd = $fields->{ (FID_TERMINAL_PWD) };
 927     $patron_pwd   = $fields->{ (FID_PATRON_PWD) };
 928     $start        = $fields->{ (FID_START_ITEM) };
 929     $end          = $fields->{ (FID_END_ITEM) };
 930
 931     $patron = $ils->find_patron($patron_id);
 932
 933     $resp = (PATRON_INFO_RESP);
 934     if ($patron) {
 935         $resp .= patron_status_string($patron);
 936         $resp .= ( defined($lang) and length($lang) == 3 ) ? $lang : $patron->language;
 937         $resp .= timestamp();
 938
 939         $resp .= add_count( 'patron_info/hold_items',    scalar @{ $patron->hold_items } );
 940         $resp .= add_count( 'patron_info/overdue_items', scalar @{ $patron->overdue_items } );
 941         $resp .= add_count( 'patron_info/charged_items', scalar @{ $patron->charged_items } );
 942         $resp .= add_count( 'patron_info/fine_items',    scalar @{ $patron->fine_items } );
 943         $resp .= add_count( 'patron_info/recall_items',  scalar @{ $patron->recall_items } );
 944         $resp .= add_count( 'patron_info/unavail_holds', scalar @{ $patron->unavail_holds } );
 945
 946         $resp .= add_field( FID_INST_ID, ( $ils->institution_id || 'SIP2' ) );
 947
 948         # while the patron ID we got from the SC is valid, let's
 949         # use the one returned from the ILS, just in case...
 950         $resp .= add_field( FID_PATRON_ID,     $patron->id );
 951         $resp .= add_field( FID_PERSONAL_NAME, $patron->name( $server->{account}->{ae_field_template} ) );
 952
 953         # TODO: add code for the fields
 954         #   hold items limit
 955         #   overdue items limit
 956         #   charged items limit
 957
 958         $resp .= add_field( FID_VALID_PATRON, 'Y' );
 959         my $password_rc;
 960         if ( defined($patron_pwd) ) {
 961
 962             # If patron password was provided, report whether it was right or not.
 963             $password_rc = $patron->check_password($patron_pwd);
 964             if ( $patron_pwd eq q{} && $server->{account}->{allow_empty_passwords} ) {
 965                 $password_rc = 1;
 966             }
 967             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $password_rc ) );
 968         }
 969
 970         $resp .= maybe_add( FID_CURRENCY, $patron->currency );
 971         $resp .= maybe_add( FID_FEE_AMT,  $patron->fee_amount );
 972         $resp .= add_field( FID_FEE_LMT, $patron->fee_limit );
 973
 974         # TODO: zero or more item details for 2.0 can go here:
 975         #          hold_items
 976         #       overdue_items
 977         #       charged_items
 978         #          fine_items
 979         #        recall_items
 980
 981         $resp .= summary_info( $ils, $patron, $summary, $start, $end, $server );
 982
 983         $resp .= maybe_add( FID_HOME_ADDR,  $patron->address );
 984         $resp .= maybe_add( FID_EMAIL,      $patron->email_addr );
 985         $resp .= maybe_add( FID_HOME_PHONE, $patron->home_phone );
 986
 987         # SIP 2.0 extensions used by Envisionware
 988         # Other terminals will ignore unrecognized fields (unrecognized field identifiers)
 989         $resp .= maybe_add( FID_PATRON_BIRTHDATE, $patron->birthdate );
 990         $resp .= maybe_add( FID_PATRON_CLASS,     $patron->ptype );
 991
 992         # Custom protocol extension to report patron internet privileges
 993         $resp .= maybe_add( FID_INET_PROFILE, $patron->inet_privileges );
 994
 995         my $msg = $patron->screen_msg;
 996         if( defined( $patron_pwd ) && !$password_rc ) {
 997             $msg .= ' -- ' . INVALID_PW;
 998         }
 999         $resp .= maybe_add( FID_SCREEN_MSG, $msg, $server );
1000         if ( $server->{account}->{send_patron_home_library_in_af} ) {
1001             $resp .= maybe_add( FID_SCREEN_MSG, $patron->{branchcode}, $server);
1002         }
1003         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line );
1004     } else {
1005
1006         # Invalid patron ID:
1007         # no privileges, no items associated,
1008         # no personal name, and is invalid (if we're using 2.00)
1009         $resp .= 'YYYY' . ( ' ' x 10 ) . $lang . timestamp();
1010         $resp .= '0000' x 6;
1011
1012         $resp .= add_field( FID_INST_ID, ( $ils->institution_id || 'SIP2' ) );
1013
1014         # patron ID is invalid, but field is required, so just echo it back
1015         $resp .= add_field( FID_PATRON_ID, $fields->{ (FID_PATRON_ID) } );
1016         $resp .= add_field( FID_PERSONAL_NAME, '' );
1017
1018         if ( $protocol_version >= 2 ) {
1019             $resp .= add_field( FID_VALID_PATRON, 'N' );
1020         }
1021         $resp .= maybe_add( FID_SCREEN_MSG, INVALID_CARD, $server );
1022     }
1023
1024     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1025     return (PATRON_INFO);
1026 }
1027
1028 sub handle_end_patron_session {
1029     my ( $self, $server ) = @_;
1030     my $ils = $server->{ils};
1031     my $trans_date;
1032     my $fields = $self->{fields};
1033     my $resp   = END_SESSION_RESP;
1034     my ( $status, $screen_msg, $print_line );
1035
1036     ($trans_date) = @{ $self->{fixed_fields} };
1037
1038     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, 'handle_end_patron_session' );
1039
1040     ( $status, $screen_msg, $print_line ) = $ils->end_patron_session( $fields->{ (FID_PATRON_ID) } );
1041
1042     $resp .= $status ? 'Y' : 'N';
1043     $resp .= timestamp();
1044
1045     $resp .= add_field( FID_INST_ID, $server->{ils}->institution );
1046     $resp .= add_field( FID_PATRON_ID, $fields->{ (FID_PATRON_ID) } );
1047
1048     $resp .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server );
1049     $resp .= maybe_add( FID_PRINT_LINE, $print_line );
1050
1051     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1052
1053     return (END_PATRON_SESSION);
1054 }
1055
1056 sub handle_fee_paid {
1057     my ( $self, $server ) = @_;
1058     my $ils = $server->{ils};
1059     my ( $trans_date, $fee_type, $pay_type, $currency ) = @{ $self->{fixed_fields} };
1060     my $fields = $self->{fields};
1061     my ( $fee_amt, $inst_id, $patron_id, $terminal_pwd, $patron_pwd );
1062     my ( $fee_id, $trans_id );
1063     my $status;
1064     my $resp = FEE_PAID_RESP;
1065
1066     my $disallow_overpayment  = $server->{account}->{disallow_overpayment};
1067     my $payment_type_writeoff = $server->{account}->{payment_type_writeoff} || q{};
1068
1069     my $is_writeoff = $pay_type eq $payment_type_writeoff;
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, $is_writeoff, $disallow_overpayment );
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( $server->{account}->{ae_field_template} ) );
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            = $server->get_timeout({ policy => 1 });
1509     $retries            = sprintf( "%03d", $policy->{retries} );
1510
1511     if ( length($retries) != 3 ) {
1512         syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1513         $retries = '000';
1514     }
1515
1516     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1517     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1518     $msg .= timestamp();
1519
1520     if ( $protocol_version == 1 ) {
1521         $msg .= '1.00';
1522     } elsif ( $protocol_version == 2 ) {
1523         $msg .= '2.00';
1524     } else {
1525         syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1526         $msg .= '1.00';
1527     }
1528
1529     # Institution ID
1530     $msg .= add_field( FID_INST_ID, $account->{institution} );
1531
1532     if ( $protocol_version >= 2 ) {
1533
1534         # Supported messages: we do it all
1535         my $supported_msgs = '';
1536
1537         foreach my $msg_name (@message_type_names) {
1538             if ( $msg_name eq 'request sc/acs resend' ) {
1539                 $supported_msgs .= sipbool(1);
1540             } else {
1541                 $supported_msgs .= sipbool( $ils->supports($msg_name) );
1542             }
1543         }
1544         if ( length($supported_msgs) < 16 ) {
1545             syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1546         }
1547         $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs );
1548     }
1549
1550     $msg .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server );
1551
1552     if (   defined( $account->{print_width} )
1553         && defined($print_line)
1554         && $account->{print_width} < length($print_line) ) {
1555         syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1556         $print_line = substr( $print_line, 0, $account->{print_width} );
1557     }
1558
1559     $msg .= maybe_add( FID_PRINT_LINE, $print_line );
1560
1561     # Do we want to tell the terminal its location?
1562
1563     $self->write_msg( $msg, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1564     return 1;
1565 }
1566
1567 #
1568 # build_patron_status: create the 14-char patron status
1569 # string for the Patron Status message
1570 #
1571 sub patron_status_string {
1572     my $patron = shift;
1573     my $patron_status;
1574
1575     syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1576     $patron_status = sprintf(
1577         '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1578         denied( $patron->charge_ok ),
1579         denied( $patron->renew_ok ),
1580         denied( $patron->recall_ok ),
1581         denied( $patron->hold_ok ),
1582         boolspace( $patron->card_lost ),
1583         boolspace( $patron->too_many_charged ),
1584         boolspace( $patron->too_many_overdue ),
1585         boolspace( $patron->too_many_renewal ),
1586         boolspace( $patron->too_many_claim_return ),
1587         boolspace( $patron->too_many_lost ),
1588         boolspace( $patron->excessive_fines ),
1589         boolspace( $patron->excessive_fees ),
1590         boolspace( $patron->recall_overdue ),
1591         boolspace( $patron->too_many_billed )
1592     );
1593     return $patron_status;
1594 }
1595
1596 sub api_auth {
1597     my ( $username, $password, $branch ) = @_;
1598     $ENV{REMOTE_USER} = $username;
1599     my $query = CGI->new();
1600     $query->param( userid   => $username );
1601     $query->param( password => $password );
1602     if ($branch) {
1603         $query->param( branch => $branch );
1604     }
1605     my ( $status, $cookie, $sessionID ) = check_api_auth( $query, { circulate => 1 }, 'intranet' );
1606     return $status;
1607 }
1608
1609 1;
1610 __END__
1611