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