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