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