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