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