C4/SIP/Sip/MsgType.pm

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