C4/SIP/Sip/MsgType.pm

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