C4/SIP/Sip/MsgType.pm

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