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