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