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