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