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