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