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