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