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