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