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
1096     my $is_writeoff = $pay_type eq $payment_type_writeoff;
1097
1098     $fee_amt    = $fields->{ (FID_FEE_AMT) };
1099     $inst_id    = $fields->{ (FID_INST_ID) };
1100     $patron_id  = $fields->{ (FID_PATRON_ID) };
1101     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1102     $fee_id     = $fields->{ (FID_FEE_ID) };
1103     $trans_id   = $fields->{ (FID_TRANSACTION_ID) };
1104
1105     $ils->check_inst_id( $inst_id, "handle_fee_paid" );
1106
1107     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 );
1108     $status = $pay_result->{status};
1109     my $pay_response = $pay_result->{pay_response};
1110
1111     my $failmap = {
1112         "no_item" => "No matching item could be found",
1113         "no_checkout" => "Item is not checked out",
1114         "too_soon" => "Cannot yet be renewed",
1115         "too_many" => "Renewed the maximum number of times",
1116         "auto_too_soon" => "Scheduled for automatic renewal and cannot yet be renewed",
1117         "auto_too_late" => "Scheduled for automatic renewal and cannot yet be any more",
1118         "auto_account_expired" => "Scheduled for automatic renewal and cannot be renewed because the patron's account has expired",
1119         "auto_renew" => "Scheduled for automatic renewal",
1120         "auto_too_much_oweing" => "Scheduled for automatic renewal",
1121         "on_reserve" => "On hold for another patron",
1122         "patron_restricted" => "Patron is currently restricted",
1123         "item_denied_renewal" => "Item is not allowed renewal",
1124         "onsite_checkout" => "Item is an onsite checkout"
1125     };
1126     my @success = ();
1127     my @fail = ();
1128     foreach my $result( @{$pay_response->{renew_result}} ) {
1129         my $item = Koha::Items->find({ itemnumber => $result->{itemnumber} });
1130         if ($result->{success}) {
1131             push @success, '"' . $item->biblio->title . '"';
1132         } else {
1133             push @fail, '"' . $item->biblio->title . '" : ' . $failmap->{$result->{error}};
1134         }
1135     }
1136
1137     my $msg = "";
1138     if (scalar @success > 0) {
1139         $msg.="The following items were renewed: " . join(", ", @success) . ". ";
1140     }
1141     if (scalar @fail > 0) {
1142         $msg.="The following items were not renewed: " . join(", ", @fail) . ".";
1143     }
1144     if (length $msg > 0) {
1145         $status->screen_msg($status->screen_msg . " $msg");
1146     }
1147
1148     $resp .= ( $status->ok ? 'Y' : 'N' ) . timestamp;
1149     $resp .= add_field( FID_INST_ID,   $inst_id, $server );
1150     $resp .= add_field( FID_PATRON_ID, $patron_id, $server );
1151     $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id, $server );
1152     $resp .= maybe_add( FID_SCREEN_MSG,     $status->screen_msg, $server, $server );
1153     $resp .= maybe_add( FID_PRINT_LINE,     $status->print_line, $server );
1154
1155     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1156
1157     return (FEE_PAID);
1158 }
1159
1160 sub handle_item_information {
1161     my ( $self, $server ) = @_;
1162     my $ils = $server->{ils};
1163     my $trans_date;
1164     my $fields = $self->{fields};
1165     my $resp   = ITEM_INFO_RESP;
1166     my $item;
1167     my $i;
1168
1169     ($trans_date) = @{ $self->{fixed_fields} };
1170
1171     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_item_information" );
1172
1173     $item = $ils->find_item( $fields->{ (FID_ITEM_ID) } );
1174
1175     if ( !defined($item) ) {
1176
1177         # Invalid Item ID
1178         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1179         $resp .= "010101";
1180         $resp .= timestamp;
1181
1182         # Just echo back the invalid item id
1183         $resp .= add_field( FID_ITEM_ID, $fields->{ (FID_ITEM_ID) }, $server );
1184
1185         # title id is required, but we don't have one
1186         $resp .= add_field( FID_TITLE_ID, '', $server );
1187     } else {
1188
1189         # Valid Item ID, send the good stuff
1190         $resp .= $item->sip_circulation_status;
1191         $resp .= $item->sip_security_marker;
1192         $resp .= $item->sip_fee_type;
1193         $resp .= timestamp;
1194
1195         $resp .= add_field( FID_ITEM_ID,  $item->id, $server );
1196         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1197
1198         $resp .= maybe_add( FID_MEDIA_TYPE,   $item->sip_media_type, $server );
1199         $resp .= maybe_add( FID_PERM_LOCN,    $item->permanent_location, $server );
1200         $resp .= maybe_add( FID_CURRENT_LOCN, $item->current_location, $server );
1201         $resp .= maybe_add( FID_ITEM_PROPS,   $item->sip_item_properties, $server );
1202
1203         if ( ( $i = $item->fee ) != 0 ) {
1204             $resp .= add_field( FID_CURRENCY, $item->fee_currency, $server );
1205             $resp .= add_field( FID_FEE_AMT,  $i, $server );
1206         }
1207         $resp .= maybe_add( FID_OWNER, $item->owner, $server );
1208
1209         if ( ( $i = scalar @{ $item->hold_queue } ) > 0 ) {
1210             $resp .= add_field( FID_HOLD_QUEUE_LEN, $i, $server );
1211         }
1212         if ( $item->due_date ) {
1213             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ), $server );
1214         }
1215         if ( ( $i = $item->recall_date ) != 0 ) {
1216             $resp .= add_field( FID_RECALL_DATE, timestamp($i), $server );
1217         }
1218         if ( ( $i = $item->hold_pickup_date ) != 0 ) {
1219             $resp .= add_field( FID_HOLD_PICKUP_DATE, timestamp($i), $server );
1220         }
1221
1222         $resp .= maybe_add( FID_SCREEN_MSG, $item->screen_msg, $server, $server );
1223         $resp .= maybe_add( FID_PRINT_LINE, $item->print_line, $server );
1224     }
1225
1226     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1227
1228     return (ITEM_INFORMATION);
1229 }
1230
1231 sub handle_item_status_update {
1232     my ( $self, $server ) = @_;
1233     my $ils = $server->{ils};
1234     my ( $trans_date, $item_id, $terminal_pwd, $item_props );
1235     my $fields = $self->{fields};
1236     my $status;
1237     my $item;
1238     my $resp = ITEM_STATUS_UPDATE_RESP;
1239
1240     ($trans_date) = @{ $self->{fixed_fields} };
1241
1242     $ils->check_inst_id( $fields->{ (FID_INST_ID) } );
1243
1244     $item_id    = $fields->{ (FID_ITEM_ID) };
1245     $item_props = $fields->{ (FID_ITEM_PROPS) };
1246
1247     if ( !defined($item_id) ) {
1248         syslog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1249     } else {
1250         $item = $ils->find_item($item_id);
1251     }
1252
1253     if ( !$item ) {
1254
1255         # Invalid Item ID
1256         $resp .= '0';
1257         $resp .= timestamp;
1258         $resp .= add_field( FID_ITEM_ID, $item_id, $server );
1259     } else {
1260
1261         # Valid Item ID
1262
1263         $status = $item->status_update($item_props);
1264
1265         $resp .= $status->ok ? '1' : '0';
1266         $resp .= timestamp;
1267
1268         $resp .= add_field( FID_ITEM_ID,  $item->id, $server );
1269         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1270         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties, $server );
1271     }
1272
1273     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server, $server );
1274     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1275
1276     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1277
1278     return (ITEM_STATUS_UPDATE);
1279 }
1280
1281 sub handle_patron_enable {
1282     my ( $self, $server ) = @_;
1283     my $ils    = $server->{ils};
1284     my $fields = $self->{fields};
1285     my ( $trans_date, $patron_id, $terminal_pwd, $patron_pwd );
1286     my ( $status, $patron );
1287     my $resp = PATRON_ENABLE_RESP;
1288
1289     ($trans_date) = @{ $self->{fixed_fields} };
1290     $patron_id  = $fields->{ (FID_PATRON_ID) };
1291     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1292
1293     syslog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1294
1295     $patron = $ils->find_patron($patron_id);
1296
1297     if ( !defined($patron) ) {
1298
1299         # Invalid patron ID
1300         $resp .= 'YYYY' . ( ' ' x 10 ) . '000' . timestamp();
1301         $resp .= add_field( FID_PATRON_ID,        $patron_id, $server );
1302         $resp .= add_field( FID_PERSONAL_NAME,    '', $server );
1303         $resp .= add_field( FID_VALID_PATRON,     'N', $server );
1304         $resp .= add_field( FID_VALID_PATRON_PWD, 'N', $server );
1305     } else {
1306
1307         # valid patron
1308         if ( !defined($patron_pwd) || $patron->check_password($patron_pwd) ) {
1309
1310             # Don't enable the patron if there was an invalid password
1311             $status = $patron->enable;
1312         }
1313         $resp .= patron_status_string($patron);
1314         $resp .= $patron->language . timestamp();
1315
1316         $resp .= add_field( FID_PATRON_ID,     $patron->id, $server );
1317         $resp .= add_field( FID_PERSONAL_NAME, $patron->name( $server->{account}->{ae_field_template} ), $server );
1318         if ( defined($patron_pwd) ) {
1319             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $patron->check_password($patron_pwd) ), $server );
1320         }
1321         $resp .= add_field( FID_VALID_PATRON, 'Y', $server );
1322         $resp .= maybe_add( FID_SCREEN_MSG, $patron->screen_msg, $server, $server );
1323         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line, $server );
1324     }
1325
1326     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1327
1328     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1329
1330     return (PATRON_ENABLE);
1331 }
1332
1333 sub handle_hold {
1334     my ( $self, $server ) = @_;
1335     my $ils = $server->{ils};
1336     my ( $hold_mode, $trans_date );
1337     my ( $expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd );
1338     my ( $item_id, $title_id, $fee_ack );
1339     my $fields = $self->{fields};
1340     my $status;
1341     my $resp = HOLD_RESP;
1342
1343     ( $hold_mode, $trans_date ) = @{ $self->{fixed_fields} };
1344
1345     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_hold" );
1346
1347     $patron_id   = $fields->{ (FID_PATRON_ID) };
1348     $expiry_date = $fields->{ (FID_EXPIRATION) } || '';
1349     $pickup_locn = $fields->{ (FID_PICKUP_LOCN) } || '';
1350     $hold_type   = $fields->{ (FID_HOLD_TYPE) } || '2';    # Any copy of title
1351     $patron_pwd  = $fields->{ (FID_PATRON_PWD) };
1352     $item_id     = $fields->{ (FID_ITEM_ID) } || '';
1353     $title_id    = $fields->{ (FID_TITLE_ID) } || '';
1354     $fee_ack     = $fields->{ (FID_FEE_ACK) } || 'N';
1355
1356     if ( $hold_mode eq '+' ) {
1357         $status = $ils->add_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1358     } elsif ( $hold_mode eq '-' ) {
1359         $status = $ils->cancel_hold( $patron_id, $patron_pwd, $item_id, $title_id );
1360     } elsif ( $hold_mode eq '*' ) {
1361         $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1362     } else {
1363         syslog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1364         $status = $ils->Transaction::Hold;    # new?
1365         $status->screen_msg("System error. Please contact library staff.");
1366     }
1367
1368     $resp .= $status->ok;
1369     $resp .= sipbool( $status->item && $status->item->available($patron_id) );
1370     $resp .= timestamp;
1371
1372     if ( $status->ok ) {
1373         $resp .= add_field( FID_PATRON_ID, $status->patron->id, $server );
1374
1375         ( $status->expiration_date )
1376           and $resp .= maybe_add( FID_EXPIRATION, timestamp( $status->expiration_date ), $server );
1377         $resp .= maybe_add( FID_QUEUE_POS,   $status->queue_position, $server );
1378         $resp .= maybe_add( FID_PICKUP_LOCN, $status->pickup_location, $server );
1379         $resp .= maybe_add( FID_ITEM_ID,     $status->item->id, $server );
1380         $resp .= maybe_add( FID_TITLE_ID,    $status->item->title_id, $server );
1381     } else {
1382
1383         # Not ok.  still need required fields
1384         $resp .= add_field( FID_PATRON_ID, $patron_id, $server );
1385     }
1386
1387     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1388     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server, $server );
1389     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1390
1391     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1392
1393     return (HOLD);
1394 }
1395
1396 sub handle_renew {
1397     my ( $self, $server ) = @_;
1398     my $ils = $server->{ils};
1399     my ( $third_party, $no_block, $trans_date, $nb_due_date );
1400     my ( $patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack );
1401     my $fields = $self->{fields};
1402     my $status;
1403     my ( $patron, $item );
1404     my $resp = RENEW_RESP;
1405
1406     ( $third_party, $no_block, $trans_date, $nb_due_date ) = @{ $self->{fixed_fields} };
1407
1408     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1409
1410     if ( $no_block eq 'Y' ) {
1411         syslog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1412     }
1413
1414     $patron_id  = $fields->{ (FID_PATRON_ID) };
1415     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1416     $item_id    = $fields->{ (FID_ITEM_ID) };
1417     $title_id   = $fields->{ (FID_TITLE_ID) };
1418     $item_props = $fields->{ (FID_ITEM_PROPS) };
1419     $fee_ack    = $fields->{ (FID_FEE_ACK) };
1420
1421     $status = $ils->renew( $patron_id, $patron_pwd, $item_id, $title_id, $no_block, $nb_due_date, $third_party, $item_props, $fee_ack );
1422
1423     $patron = $status->patron;
1424     $item   = $status->item;
1425
1426     if ( $status->renewal_ok ) {
1427         $resp .= '1';
1428         $resp .= $status->renewal_ok ? 'Y' : 'N';
1429         if ( $ils->supports('magnetic media') ) {
1430             $resp .= sipbool( $item->magnetic_media );
1431         } else {
1432             $resp .= 'U';
1433         }
1434         $resp .= sipbool( $status->desensitize );
1435         $resp .= timestamp;
1436         $resp .= add_field( FID_PATRON_ID, $patron->id, $server );
1437         $resp .= add_field( FID_ITEM_ID, $item->id, $server );
1438         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1439         if ( $item->due_date ) {
1440             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ), $server );
1441         } else {
1442             $resp .= add_field( FID_DUE_DATE, q{}, $server );
1443         }
1444         if ( $ils->supports('security inhibit') ) {
1445             $resp .= add_field( FID_SECURITY_INHIBIT, $status->security_inhibit, $server );
1446         }
1447         $resp .= add_field( FID_MEDIA_TYPE, $item->sip_media_type, $server );
1448         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties, $server );
1449     } else {
1450
1451         # renew failed for some reason
1452         # not OK, renewal not OK, Unknown media type (why bother checking?)
1453         $resp .= '0NUN';
1454         $resp .= timestamp;
1455
1456         # If we found the patron or the item, the return the ILS
1457         # information, otherwise echo back the information we received
1458         # from the terminal
1459         $resp .= add_field( FID_PATRON_ID, $patron ? $patron->id     : $patron_id, $server );
1460         $resp .= add_field( FID_ITEM_ID,   $item   ? $item->id       : $item_id, $server );
1461         $resp .= add_field( FID_TITLE_ID,  $item   ? $item->title_id : $title_id, $server );
1462         $resp .= add_field( FID_DUE_DATE,  '', $server );
1463     }
1464
1465     if ( $status->fee_amount ) {
1466         $resp .= add_field( FID_FEE_AMT, $status->fee_amount, $server );
1467         $resp .= maybe_add( FID_CURRENCY,       $status->sip_currency, $server );
1468         $resp .= maybe_add( FID_FEE_TYPE,       $status->sip_fee_type, $server );
1469         $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id, $server );
1470     }
1471
1472     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1473     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server, $server );
1474     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1475
1476     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1477
1478     return (RENEW);
1479 }
1480
1481 sub handle_renew_all {
1482
1483     # my ($third_party, $no_block, $nb_due_date, $fee_ack, $patron);
1484
1485     my ( $self, $server ) = @_;
1486     my $ils = $server->{ils};
1487     my ( $trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack );
1488     my $fields = $self->{fields};
1489     my $resp   = RENEW_ALL_RESP;
1490     my $status;
1491     my ( @renewed, @unrenewed );
1492
1493     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew_all" );
1494
1495     ($trans_date) = @{ $self->{fixed_fields} };
1496
1497     $patron_id    = $fields->{ (FID_PATRON_ID) };
1498     $patron_pwd   = $fields->{ (FID_PATRON_PWD) };
1499     $terminal_pwd = $fields->{ (FID_TERMINAL_PWD) };
1500     $fee_ack      = $fields->{ (FID_FEE_ACK) };
1501
1502     $status = $ils->renew_all( $patron_id, $patron_pwd, $fee_ack );
1503
1504     $resp .= $status->ok ? '1' : '0';
1505
1506     if ( !$status->ok ) {
1507         $resp .= add_count( "renew_all/renewed_count",   0 );
1508         $resp .= add_count( "renew_all/unrenewed_count", 0 );
1509         @renewed   = ();
1510         @unrenewed = ();
1511     } else {
1512         @renewed   = ( @{ $status->renewed } );
1513         @unrenewed = ( @{ $status->unrenewed } );
1514         $resp .= add_count( "renew_all/renewed_count",   scalar @renewed );
1515         $resp .= add_count( "renew_all/unrenewed_count", scalar @unrenewed );
1516     }
1517
1518     $resp .= timestamp;
1519     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1520
1521     $resp .= join( '', map( add_field( FID_RENEWED_ITEMS,   $_ ), @renewed ), $server );
1522     $resp .= join( '', map( add_field( FID_UNRENEWED_ITEMS, $_ ), @unrenewed ), $server );
1523
1524     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server, $server );
1525     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1526
1527     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1528
1529     return (RENEW_ALL);
1530 }
1531
1532 #
1533 # send_acs_status($self, $server)
1534 #
1535 # Send an ACS Status message, which is contains lots of little fields
1536 # of information gleaned from all sorts of places.
1537 #
1538
1539 my @message_type_names = (
1540     "patron status request",
1541     "checkout",
1542     "checkin",
1543     "block patron",
1544     "acs status",
1545     "request sc/acs resend",
1546     "login",
1547     "patron information",
1548     "end patron session",
1549     "fee paid",
1550     "item information",
1551     "item status update",
1552     "patron enable",
1553     "hold",
1554     "renew",
1555     "renew all",
1556 );
1557
1558 sub send_acs_status {
1559     my ( $self, $server, $screen_msg, $print_line ) = @_;
1560     my $msg = ACS_STATUS;
1561     ($server) or die "send_acs_status error: no \$server argument received";
1562     my $account = $server->{account} or die "send_acs_status error: no 'account' in \$server object:\n" . Dumper($server);
1563     my $policy  = $server->{policy}  or die "send_acs_status error: no 'policy' in \$server object:\n" . Dumper($server);
1564     my $ils     = $server->{ils}     or die "send_acs_status error: no 'ils' in \$server object:\n" . Dumper($server);
1565     my ( $online_status,    $checkin_ok, $checkout_ok, $ACS_renewal_policy );
1566     my ( $status_update_ok, $offline_ok, $timeout,     $retries );
1567
1568     $online_status      = 'Y';
1569     $checkout_ok        = sipbool( $ils->checkout_ok );
1570     $checkin_ok         = sipbool( $ils->checkin_ok );
1571     $ACS_renewal_policy = sipbool( $policy->{renewal} );
1572     $status_update_ok   = sipbool( $ils->status_update_ok );
1573     $offline_ok         = sipbool( $ils->offline_ok );
1574     $timeout            = $server->get_timeout({ policy => 1 });
1575     $retries            = sprintf( "%03d", $policy->{retries} );
1576
1577     if ( length($retries) != 3 ) {
1578         syslog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1579         $retries = '000';
1580     }
1581
1582     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1583     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1584     $msg .= timestamp();
1585
1586     if ( $protocol_version == 1 ) {
1587         $msg .= '1.00';
1588     } elsif ( $protocol_version == 2 ) {
1589         $msg .= '2.00';
1590     } else {
1591         syslog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1592         $msg .= '1.00';
1593     }
1594
1595     # Institution ID
1596     $msg .= add_field( FID_INST_ID, $account->{institution}, $server );
1597
1598     if ( $protocol_version >= 2 ) {
1599
1600         # Supported messages: we do it all
1601         my $supported_msgs = '';
1602
1603         foreach my $msg_name (@message_type_names) {
1604             if ( $msg_name eq 'request sc/acs resend' ) {
1605                 $supported_msgs .= sipbool(1);
1606             } else {
1607                 $supported_msgs .= sipbool( $ils->supports($msg_name) );
1608             }
1609         }
1610         if ( length($supported_msgs) < 16 ) {
1611             syslog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1612         }
1613         $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1614     }
1615
1616     $msg .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server, $server );
1617
1618     if (   defined( $account->{print_width} )
1619         && defined($print_line)
1620         && $account->{print_width} < length($print_line) ) {
1621         syslog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1622         $print_line = substr( $print_line, 0, $account->{print_width} );
1623     }
1624
1625     $msg .= maybe_add( FID_PRINT_LINE, $print_line, $server );
1626
1627     # Do we want to tell the terminal its location?
1628
1629     $self->write_msg( $msg, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1630     return 1;
1631 }
1632
1633 #
1634 # build_patron_status: create the 14-char patron status
1635 # string for the Patron Status message
1636 #
1637 sub patron_status_string {
1638     my $patron = shift;
1639     my $patron_status;
1640
1641     syslog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1642     $patron_status = sprintf(
1643         '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1644         denied( $patron->charge_ok ),
1645         denied( $patron->renew_ok ),
1646         denied( $patron->recall_ok ),
1647         denied( $patron->hold_ok ),
1648         boolspace( $patron->card_lost ),
1649         boolspace( $patron->too_many_charged ),
1650         boolspace( $patron->too_many_overdue ),
1651         boolspace( $patron->too_many_renewal ),
1652         boolspace( $patron->too_many_claim_return ),
1653         boolspace( $patron->too_many_lost ),
1654         boolspace( $patron->excessive_fines ),
1655         boolspace( $patron->excessive_fees ),
1656         boolspace( $patron->recall_overdue ),
1657         boolspace( $patron->too_many_billed )
1658     );
1659     return $patron_status;
1660 }
1661
1662 sub api_auth {
1663     my ( $username, $password, $branch ) = @_;
1664     $ENV{REMOTE_USER} = $username;
1665     my $query = CGI->new();
1666     $query->param( userid   => $username );
1667     $query->param( password => $password );
1668     if ($branch) {
1669         $query->param( branch => $branch );
1670     }
1671     my ( $status, $cookie, $sessionID ) = check_api_auth( $query, { circulate => 1 }, 'intranet' );
1672     return $status;
1673 }
1674
1675 1;
1676 __END__
1677