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     };
1172     my @success = ();
1173     my @fail = ();
1174     foreach my $result( @{$pay_response->{renew_result}} ) {
1175         my $item = Koha::Items->find({ itemnumber => $result->{itemnumber} });
1176         if ($result->{success}) {
1177             push @success, '"' . $item->biblio->title . '"';
1178         } else {
1179             push @fail, '"' . $item->biblio->title . '" : ' . $failmap->{$result->{error}};
1180         }
1181     }
1182
1183     my $msg = "";
1184     if (scalar @success > 0) {
1185         $msg.="The following items were renewed: " . join(", ", @success) . ". ";
1186     }
1187     if (scalar @fail > 0) {
1188         $msg.="The following items were not renewed: " . join(", ", @fail) . ".";
1189     }
1190     if (length $msg > 0) {
1191         $status->screen_msg($status->screen_msg . " $msg");
1192     }
1193
1194     $resp .= ( $status->ok ? 'Y' : 'N' ) . timestamp;
1195     $resp .= add_field( FID_INST_ID,   $inst_id, $server );
1196     $resp .= add_field( FID_PATRON_ID, $patron_id, $server );
1197     $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id, $server );
1198     $resp .= maybe_add( FID_SCREEN_MSG,     $pay_result->{error}, $server );
1199     $resp .= maybe_add( FID_SCREEN_MSG,     $status->screen_msg, $server );
1200     $resp .= maybe_add( FID_PRINT_LINE,     $status->print_line, $server );
1201
1202     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1203
1204     return (FEE_PAID);
1205 }
1206
1207 sub handle_item_information {
1208     my ( $self, $server ) = @_;
1209     my $account = $server->{account};
1210     my $ils     = $server->{ils};
1211     my $fields  = $self->{fields};
1212     my $resp    = ITEM_INFO_RESP;
1213     my $trans_date;
1214     my $item;
1215     my $i;
1216
1217     ($trans_date) = @{ $self->{fixed_fields} };
1218
1219     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_item_information" );
1220
1221     $item = $ils->find_item( $fields->{ (FID_ITEM_ID) } );
1222
1223     if ( !defined($item) ) {
1224
1225         # Invalid Item ID
1226         # "Other" circ stat, "Other" security marker, "Unknown" fee type
1227         $resp .= "010101";
1228         $resp .= timestamp;
1229
1230         # Just echo back the invalid item id
1231         $resp .= add_field( FID_ITEM_ID, $fields->{ (FID_ITEM_ID) }, $server );
1232
1233         # title id is required, but we don't have one
1234         $resp .= add_field( FID_TITLE_ID, '', $server );
1235     } else {
1236         my $seen = $account->{seen_on_item_information};
1237         ModDateLastSeen( $item->itemnumber, $seen eq 'keep_lost' ) if $seen;
1238
1239         # Valid Item ID, send the good stuff
1240         my $circulation_status = $item->sip_circulation_status;
1241         $resp .= $circulation_status;
1242         $resp .= $item->sip_security_marker;
1243         $resp .= $item->sip_fee_type;
1244         $resp .= timestamp;
1245
1246         if ( $circulation_status eq '01' ) {
1247             $resp .= maybe_add( FID_SCREEN_MSG, "Item is damaged", $server );
1248         }
1249
1250         $resp .= add_field( FID_ITEM_ID,  $item->id, $server );
1251         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1252
1253         $resp .= maybe_add( FID_MEDIA_TYPE,   $item->sip_media_type, $server );
1254         $resp .= maybe_add( FID_PERM_LOCN,    $item->permanent_location, $server );
1255         $resp .= maybe_add( FID_CURRENT_LOCN, $item->current_location, $server );
1256         $resp .= maybe_add( FID_ITEM_PROPS,   $item->sip_item_properties, $server );
1257
1258
1259         if ( my $CR = $server->{account}->{cr_item_field} ) {
1260                 $resp .= maybe_add( FID_COLLECTION_CODE, $item->{$CR}, $server );
1261         } else {
1262           $resp .= maybe_add( FID_COLLECTION_CODE, $item->collection_code, $server );
1263         }
1264
1265         if ( ( $i = $item->fee ) != 0 ) {
1266             $resp .= add_field( FID_CURRENCY, $item->fee_currency, $server );
1267             $resp .= add_field( FID_FEE_AMT,  $i, $server );
1268         }
1269         $resp .= maybe_add( FID_OWNER, $item->owner, $server );
1270
1271         if ( ( $i = scalar @{ $item->hold_queue } ) > 0 ) {
1272             $resp .= add_field( FID_HOLD_QUEUE_LEN, $i, $server );
1273         }
1274         if ( $item->due_date ) {
1275             my $due_date =
1276               $account->{format_due_date}
1277               ? output_pref( { str => $item->due_date, as_due_date => 1 } )
1278               : timestamp( $item->due_date );
1279             $resp .= add_field( FID_DUE_DATE, $due_date, $server );
1280         }
1281         if ( ( $i = $item->recall_date ) != 0 ) {
1282             $resp .= add_field( FID_RECALL_DATE, timestamp($i), $server );
1283         }
1284         if ( ( $i = $item->hold_pickup_date ) != 0 ) {
1285             $resp .= add_field( FID_HOLD_PICKUP_DATE, timestamp($i), $server );
1286         }
1287
1288         $resp .= maybe_add( FID_SCREEN_MSG, $item->screen_msg, $server );
1289         $resp .= maybe_add( FID_PRINT_LINE, $item->print_line, $server );
1290
1291         $resp .= $item->build_additional_item_fields_string( $server );
1292         $resp .= $item->build_custom_field_string( $server );
1293     }
1294
1295     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1296
1297     return (ITEM_INFORMATION);
1298 }
1299
1300 sub handle_item_status_update {
1301     my ( $self, $server ) = @_;
1302     my $ils = $server->{ils};
1303     my ( $trans_date, $item_id, $terminal_pwd, $item_props );
1304     my $fields = $self->{fields};
1305     my $status;
1306     my $item;
1307     my $resp = ITEM_STATUS_UPDATE_RESP;
1308
1309     ($trans_date) = @{ $self->{fixed_fields} };
1310
1311     $ils->check_inst_id( $fields->{ (FID_INST_ID) } );
1312
1313     $item_id    = $fields->{ (FID_ITEM_ID) };
1314     $item_props = $fields->{ (FID_ITEM_PROPS) };
1315
1316     if ( !defined($item_id) ) {
1317         siplog( "LOG_WARNING", "handle_item_status: received message without Item ID field" );
1318     } else {
1319         $item = $ils->find_item($item_id);
1320     }
1321
1322     if ( !$item ) {
1323
1324         # Invalid Item ID
1325         $resp .= '0';
1326         $resp .= timestamp;
1327         $resp .= add_field( FID_ITEM_ID, $item_id, $server );
1328     } else {
1329
1330         # Valid Item ID
1331
1332         $status = $item->status_update($item_props);
1333
1334         $resp .= $status->ok ? '1' : '0';
1335         $resp .= timestamp;
1336
1337         $resp .= add_field( FID_ITEM_ID,  $item->id, $server );
1338         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1339         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties, $server );
1340     }
1341
1342     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1343     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1344
1345     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1346
1347     return (ITEM_STATUS_UPDATE);
1348 }
1349
1350 sub handle_patron_enable {
1351     my ( $self, $server ) = @_;
1352     my $ils    = $server->{ils};
1353     my $fields = $self->{fields};
1354     my ( $trans_date, $patron_id, $terminal_pwd, $patron_pwd );
1355     my ( $status, $patron );
1356     my $resp = PATRON_ENABLE_RESP;
1357
1358     ($trans_date) = @{ $self->{fixed_fields} };
1359     $patron_id  = $fields->{ (FID_PATRON_ID) };
1360     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1361
1362     Koha::Plugins->call('patron_barcode_transform', \$patron_id );
1363
1364     siplog( "LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd );
1365
1366     $patron = $ils->find_patron($patron_id);
1367
1368     if ( !defined($patron) ) {
1369
1370         # Invalid patron ID
1371         $resp .= 'YYYY' . ( ' ' x 10 ) . '000' . timestamp();
1372         $resp .= add_field( FID_PATRON_ID,        $patron_id, $server );
1373         $resp .= add_field( FID_PERSONAL_NAME,    '', $server );
1374         $resp .= add_field( FID_VALID_PATRON,     'N', $server );
1375         $resp .= add_field( FID_VALID_PATRON_PWD, 'N', $server );
1376     } else {
1377
1378         # valid patron
1379         if ( !defined($patron_pwd) || $patron->check_password($patron_pwd) ) {
1380
1381             # Don't enable the patron if there was an invalid password
1382             $status = $patron->enable;
1383         }
1384         $resp .= patron_status_string( $patron, $server );
1385         $resp .= $patron->language . timestamp();
1386
1387         $resp .= add_field( FID_PATRON_ID,     $patron->id, $server );
1388         $resp .= add_field( FID_PERSONAL_NAME, $patron->format( $server->{account}->{ae_field_template} ), $server );
1389         if ( defined($patron_pwd) ) {
1390             $resp .= add_field( FID_VALID_PATRON_PWD, sipbool( $patron->check_password($patron_pwd) ), $server );
1391         }
1392         $resp .= add_field( FID_VALID_PATRON, 'Y', $server );
1393         $resp .= maybe_add( FID_SCREEN_MSG, $patron->screen_msg, $server );
1394         $resp .= maybe_add( FID_PRINT_LINE, $patron->print_line, $server );
1395     }
1396
1397     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1398
1399     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1400
1401     return (PATRON_ENABLE);
1402 }
1403
1404 sub handle_hold {
1405     my ( $self, $server ) = @_;
1406     my $ils = $server->{ils};
1407     my ( $hold_mode, $trans_date );
1408     my ( $expiry_date, $pickup_locn, $hold_type, $patron_id, $patron_pwd );
1409     my ( $item_id, $title_id, $fee_ack );
1410     my $fields = $self->{fields};
1411     my $status;
1412     my $resp = HOLD_RESP;
1413
1414     ( $hold_mode, $trans_date ) = @{ $self->{fixed_fields} };
1415
1416     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_hold" );
1417
1418     $patron_id   = $fields->{ (FID_PATRON_ID) };
1419     $expiry_date = $fields->{ (FID_EXPIRATION) } || '';
1420     $pickup_locn = $fields->{ (FID_PICKUP_LOCN) } || '';
1421     $hold_type   = $fields->{ (FID_HOLD_TYPE) } || '2';    # Any copy of title
1422     $patron_pwd  = $fields->{ (FID_PATRON_PWD) };
1423     $item_id     = $fields->{ (FID_ITEM_ID) } || '';
1424     $title_id    = $fields->{ (FID_TITLE_ID) } || '';
1425     $fee_ack     = $fields->{ (FID_FEE_ACK) } || 'N';
1426
1427     Koha::Plugins->call('patron_barcode_transform', \$patron_id );
1428
1429     if ( $hold_mode eq '+' ) {
1430         $status = $ils->add_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1431     } elsif ( $hold_mode eq '-' ) {
1432         $status = $ils->cancel_hold( $patron_id, $patron_pwd, $item_id, $title_id );
1433     } elsif ( $hold_mode eq '*' ) {
1434         $status = $ils->alter_hold( $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack );
1435     } else {
1436         siplog( "LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", $hold_mode, $server->{account}->{id} );
1437         $status = $ils->Transaction::Hold;    # new?
1438         $status->screen_msg("System error. Please contact library staff.");
1439     }
1440
1441     $resp .= $status->ok;
1442     $resp .= sipbool( $status->item && $status->item->available($patron_id) );
1443     $resp .= timestamp;
1444
1445     if ( $status->ok ) {
1446         $resp .= add_field( FID_PATRON_ID, $status->patron->id, $server );
1447
1448         ( $status->expiration_date )
1449           and $resp .= maybe_add( FID_EXPIRATION, timestamp( $status->expiration_date ), $server );
1450         $resp .= maybe_add( FID_QUEUE_POS,   $status->queue_position, $server );
1451         $resp .= maybe_add( FID_PICKUP_LOCN, $status->pickup_location, $server );
1452         $resp .= maybe_add( FID_ITEM_ID,     $status->item->id, $server );
1453         $resp .= maybe_add( FID_TITLE_ID,    $status->item->title_id, $server );
1454     } else {
1455
1456         # Not ok.  still need required fields
1457         $resp .= add_field( FID_PATRON_ID, $patron_id, $server );
1458     }
1459
1460     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1461     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1462     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1463
1464     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1465
1466     return (HOLD);
1467 }
1468
1469 sub handle_renew {
1470     my ( $self, $server ) = @_;
1471     my $ils = $server->{ils};
1472     my ( $third_party, $no_block, $trans_date, $nb_due_date );
1473     my ( $patron_id, $patron_pwd, $item_id, $title_id, $item_props, $fee_ack );
1474     my $fields = $self->{fields};
1475     my $status;
1476     my ( $patron, $item );
1477     my $resp = RENEW_RESP;
1478
1479     ( $third_party, $no_block, $trans_date, $nb_due_date ) = @{ $self->{fixed_fields} };
1480
1481     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew" );
1482
1483     if ( $no_block eq 'Y' ) {
1484         siplog( "LOG_WARNING", "handle_renew: received 'no block' renewal from terminal '%s'", $server->{account}->{id} );
1485     }
1486
1487     $patron_id  = $fields->{ (FID_PATRON_ID) };
1488     $patron_pwd = $fields->{ (FID_PATRON_PWD) };
1489     $item_id    = $fields->{ (FID_ITEM_ID) };
1490     $title_id   = $fields->{ (FID_TITLE_ID) };
1491     $item_props = $fields->{ (FID_ITEM_PROPS) };
1492     $fee_ack    = $fields->{ (FID_FEE_ACK) };
1493
1494     Koha::Plugins->call('patron_barcode_transform', \$patron_id );
1495
1496     $status = $ils->renew( $patron_id, $patron_pwd, $item_id, $title_id, $no_block, $nb_due_date, $third_party, $item_props, $fee_ack );
1497
1498     $patron = $status->patron;
1499     $item   = $status->item;
1500
1501     if ( $status->renewal_ok ) {
1502         $resp .= '1';
1503         $resp .= $status->renewal_ok ? 'Y' : 'N';
1504         if ( $ils->supports('magnetic media') ) {
1505             $resp .= sipbool( $item->magnetic_media );
1506         } else {
1507             $resp .= 'U';
1508         }
1509         $resp .= sipbool( desensitize( { status => $status, patron => $patron, server => $server } ) );
1510         $resp .= timestamp;
1511         $resp .= add_field( FID_PATRON_ID, $patron->id, $server );
1512         $resp .= add_field( FID_ITEM_ID, $item->id, $server );
1513         $resp .= add_field( FID_TITLE_ID, $item->title_id, $server );
1514         if ( $item->due_date ) {
1515             $resp .= add_field( FID_DUE_DATE, timestamp( $item->due_date ), $server );
1516         } else {
1517             $resp .= add_field( FID_DUE_DATE, q{}, $server );
1518         }
1519         if ( $ils->supports('security inhibit') ) {
1520             $resp .= add_field( FID_SECURITY_INHIBIT, $status->security_inhibit, $server );
1521         }
1522         $resp .= add_field( FID_MEDIA_TYPE, $item->sip_media_type, $server );
1523         $resp .= maybe_add( FID_ITEM_PROPS, $item->sip_item_properties, $server );
1524     } else {
1525
1526         # renew failed for some reason
1527         # not OK, renewal not OK, Unknown media type (why bother checking?)
1528         $resp .= '0NUN';
1529         $resp .= timestamp;
1530
1531         # If we found the patron or the item, the return the ILS
1532         # information, otherwise echo back the information we received
1533         # from the terminal
1534         $resp .= add_field( FID_PATRON_ID, $patron ? $patron->id     : $patron_id, $server );
1535         $resp .= add_field( FID_ITEM_ID,   $item   ? $item->id       : $item_id, $server );
1536         $resp .= add_field( FID_TITLE_ID,  $item   ? $item->title_id : $title_id, $server );
1537         $resp .= add_field( FID_DUE_DATE,  '', $server );
1538     }
1539
1540     if ( $status->fee_amount ) {
1541         $resp .= add_field( FID_FEE_AMT, $status->fee_amount, $server );
1542         $resp .= maybe_add( FID_CURRENCY,       $status->sip_currency, $server );
1543         $resp .= maybe_add( FID_FEE_TYPE,       $status->sip_fee_type, $server );
1544         $resp .= maybe_add( FID_TRANSACTION_ID, $status->transaction_id, $server );
1545     }
1546
1547     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1548     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1549     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1550
1551     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1552
1553     return (RENEW);
1554 }
1555
1556 sub handle_renew_all {
1557
1558     # my ($third_party, $no_block, $nb_due_date, $fee_ack, $patron);
1559
1560     my ( $self, $server ) = @_;
1561     my $ils = $server->{ils};
1562     my ( $trans_date, $patron_id, $patron_pwd, $terminal_pwd, $fee_ack );
1563     my $fields = $self->{fields};
1564     my $resp   = RENEW_ALL_RESP;
1565     my $status;
1566     my ( @renewed, @unrenewed );
1567
1568     $ils->check_inst_id( $fields->{ (FID_INST_ID) }, "handle_renew_all" );
1569
1570     ($trans_date) = @{ $self->{fixed_fields} };
1571
1572     $patron_id    = $fields->{ (FID_PATRON_ID) };
1573     $patron_pwd   = $fields->{ (FID_PATRON_PWD) };
1574     $terminal_pwd = $fields->{ (FID_TERMINAL_PWD) };
1575     $fee_ack      = $fields->{ (FID_FEE_ACK) };
1576
1577     Koha::Plugins->call('patron_barcode_transform', \$patron_id );
1578
1579     $status = $ils->renew_all( $patron_id, $patron_pwd, $fee_ack );
1580
1581     $resp .= $status->ok ? '1' : '0';
1582
1583     if ( !$status->ok ) {
1584         $resp .= add_count( "renew_all/renewed_count",   0 );
1585         $resp .= add_count( "renew_all/unrenewed_count", 0 );
1586         @renewed   = ();
1587         @unrenewed = ();
1588     } else {
1589         @renewed   = ( @{ $status->renewed } );
1590         @unrenewed = ( @{ $status->unrenewed } );
1591         $resp .= add_count( "renew_all/renewed_count",   scalar @renewed );
1592         $resp .= add_count( "renew_all/unrenewed_count", scalar @unrenewed );
1593     }
1594
1595     $resp .= timestamp;
1596     $resp .= add_field( FID_INST_ID, $ils->institution, $server );
1597
1598     $resp .= join( '', map( add_field( FID_RENEWED_ITEMS,   $_ ), @renewed ), $server );
1599     $resp .= join( '', map( add_field( FID_UNRENEWED_ITEMS, $_ ), @unrenewed ), $server );
1600
1601     $resp .= maybe_add( FID_SCREEN_MSG, $status->screen_msg, $server );
1602     $resp .= maybe_add( FID_PRINT_LINE, $status->print_line, $server );
1603
1604     $self->write_msg( $resp, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1605
1606     return (RENEW_ALL);
1607 }
1608
1609 #
1610 # send_acs_status($self, $server)
1611 #
1612 # Send an ACS Status message, which is contains lots of little fields
1613 # of information gleaned from all sorts of places.
1614 #
1615
1616 my @message_type_names = (
1617     "patron status request",
1618     "checkout",
1619     "checkin",
1620     "block patron",
1621     "acs status",
1622     "request sc/acs resend",
1623     "login",
1624     "patron information",
1625     "end patron session",
1626     "fee paid",
1627     "item information",
1628     "item status update",
1629     "patron enable",
1630     "hold",
1631     "renew",
1632     "renew all",
1633 );
1634
1635 sub send_acs_status {
1636     my ( $self, $server, $screen_msg, $print_line ) = @_;
1637
1638     my $msg = ACS_STATUS;
1639     ($server) or die "send_acs_status error: no \$server argument received";
1640     my $account = $server->{account} or die "send_acs_status error: no 'account' in \$server object:\n" . Dumper($server);
1641     my $policy  = $server->{policy}  or die "send_acs_status error: no 'policy' in \$server object:\n" . Dumper($server);
1642     my $ils     = $server->{ils}     or die "send_acs_status error: no 'ils' in \$server object:\n" . Dumper($server);
1643     my $sip_username = $server->{sip_username} or die "send_acs_status error: no 'sip_username' in \$server object:\n" . Dumper($server);
1644     my ( $online_status,    $checkin_ok, $checkout_ok, $ACS_renewal_policy );
1645     my ( $status_update_ok, $offline_ok, $timeout,     $retries );
1646     my $sip_user = Koha::Patrons->find({ userid => $sip_username });
1647     die "send_acs_status error: sip_username cannot be found in DB or DB cannot be reached" unless $sip_user;
1648
1649     $online_status      = 'Y';
1650     $checkout_ok        = sipbool( $ils->checkout_ok );
1651     $checkin_ok         = sipbool( $ils->checkin_ok );
1652     $ACS_renewal_policy = sipbool( $policy->{renewal} );
1653     $status_update_ok   = sipbool( $ils->status_update_ok );
1654     $offline_ok         = sipbool( $ils->offline_ok );
1655     $timeout            = $server->get_timeout({ policy => 1 });
1656     $retries            = sprintf( "%03d", $policy->{retries} );
1657
1658     if ( length($retries) != 3 ) {
1659         siplog( "LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries );
1660         $retries = '000';
1661     }
1662
1663     $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy";
1664     $msg .= "$status_update_ok$offline_ok$timeout$retries";
1665     $msg .= timestamp();
1666
1667     if ( $protocol_version == 1 ) {
1668         $msg .= '1.00';
1669     } elsif ( $protocol_version == 2 ) {
1670         $msg .= '2.00';
1671     } else {
1672         siplog( "LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version );
1673         $msg .= '1.00';
1674     }
1675
1676     # Institution ID
1677     $msg .= add_field( FID_INST_ID, $account->{institution}, $server );
1678
1679     if ( $protocol_version >= 2 ) {
1680
1681         # Supported messages: we do it all
1682         my $supported_msgs = '';
1683
1684         foreach my $msg_name (@message_type_names) {
1685             if ( $msg_name eq 'request sc/acs resend' ) {
1686                 $supported_msgs .= sipbool(1);
1687             } else {
1688                 $supported_msgs .= sipbool( $ils->supports($msg_name) );
1689             }
1690         }
1691         if ( length($supported_msgs) < 16 ) {
1692             siplog( "LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs );
1693         }
1694         $msg .= add_field( FID_SUPPORTED_MSGS, $supported_msgs, $server );
1695     }
1696
1697     $msg .= maybe_add( FID_SCREEN_MSG, $screen_msg, $server );
1698
1699     if (   defined( $account->{print_width} )
1700         && defined($print_line)
1701         && $account->{print_width} < length($print_line) ) {
1702         siplog( "LOG_WARNING", "send_acs_status: print line '%s' too long.  Truncating", $print_line );
1703         $print_line = substr( $print_line, 0, $account->{print_width} );
1704     }
1705
1706     $msg .= maybe_add( FID_PRINT_LINE, $print_line, $server );
1707
1708     # Do we want to tell the terminal its location?
1709
1710     $self->write_msg( $msg, undef, $server->{account}->{terminator}, $server->{account}->{encoding} );
1711     return 1;
1712 }
1713
1714 #
1715 # build_patron_status: create the 14-char patron status
1716 # string for the Patron Status message
1717 #
1718 sub patron_status_string {
1719     my $patron = shift;
1720     my $server = shift;
1721
1722     my $patron_status;
1723
1724     siplog( "LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok );
1725     $patron_status = sprintf(
1726         '%s%s%s%s%s%s%s%s%s%s%s%s%s%s',
1727         denied( $patron->charge_ok ),
1728         denied( $patron->renew_ok ),
1729         denied( $patron->recall_ok ),
1730         denied( $patron->hold_ok ),
1731         boolspace( $patron->card_lost ),
1732         boolspace( $patron->too_many_charged ),
1733         $server->{account}->{overdues_block_checkout} ? boolspace( $patron->too_many_overdue ) : q{ },
1734         boolspace( $patron->too_many_renewal ),
1735         boolspace( $patron->too_many_claim_return ),
1736         boolspace( $patron->too_many_lost( $server ) ),
1737         boolspace( $patron->excessive_fines ),
1738         boolspace( $patron->excessive_fees ),
1739         boolspace( $patron->recall_overdue ),
1740         boolspace( $patron->too_many_billed )
1741     );
1742     return $patron_status;
1743 }
1744
1745 sub api_auth {
1746     my ( $username, $password, $branch ) = @_;
1747     $ENV{REMOTE_USER} = $username;
1748     my $query = CGI->new();
1749     $query->param( userid   => $username );
1750     $query->param( password => $password );
1751     if ($branch) {
1752         $query->param( branch => $branch );
1753     }
1754     my ( $status, $cookie, $sessionID ) = check_api_auth( $query, { circulate => 1 }, 'intranet' );
1755     return $status;
1756 }
1757
1758 sub desensitize {
1759     my ($params) = @_;
1760
1761     my $status      = $params->{status};
1762     my $desensitize = $status->desensitize();
1763
1764     # If desenstize is already false, no need to do anything
1765     return unless $desensitize;
1766
1767     my $patron = $params->{patron};
1768     my $item   = $params->{item};
1769     my $server = $params->{server};
1770
1771     my $patron_categories = $server->{account}->{inhouse_patron_categories} // q{};
1772     my $item_types = $server->{account}->{inhouse_item_types} // q{};
1773
1774     # If no patron categories or item types are set for never desensitize, no need to do anything
1775     return $desensitize unless $patron_categories || $item_types;
1776
1777     my $patron_category = $patron->ptype();
1778     my @patron_categories = split( /,/, $patron_categories );
1779     my $found_patron_category = grep( /^$patron_category$/, @patron_categories );
1780     return 0 if $found_patron_category;
1781
1782     my $item_type = $item->itemtype;
1783     my @item_types = split( /,/, $item_types );
1784     my $found_item_type = grep( /^$item_type$/, @item_types );
1785     return 0 if $found_item_type;
1786
1787     return 1;
1788 }
1789
1790 1;
1791 __END__
1792