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