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