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