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