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