Revert "LP#1296937: (follow-up) $ids_only is now the last parameter for ->charged_items"
[sitka/SIPServer.git] / Sip / MsgType.pm
CommitLineData
863db634 1#
0fca9208 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#
863db634 20# Sip::MsgType.pm
21#
22# A Class for handing SIP messages
23#
24
25package Sip::MsgType;
26
27use strict;
28use warnings;
29use Exporter;
30use Sys::Syslog qw(syslog);
e73ed630 31use UNIVERSAL qw(can);
863db634 32
3272f95c 33use Sip qw(:all);
863db634 34use Sip::Constants qw(:all);
e73ed630 35use Sip::Checksum qw(verify_cksum);
863db634 36
0e64db40 37use Data::Dumper;
38
ba1da199 39our (@ISA, @EXPORT_OK, $VERSION);
863db634 40
41@ISA = qw(Exporter);
42@EXPORT_OK = qw(handle);
ba1da199 43$VERSION = 0.02;
863db634 44
45# Predeclare handler subroutines
46use 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
64my %handlers = (
65 (PATRON_STATUS_REQ) => {
66 name => "Patron Status Request",
67 handler => \&handle_patron_status,
68 protocol => {
71756501 69 1 => {
863db634 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 => {
71756501 81 1 => {
863db634 82 template => "CCA18A18",
83 template_len => 38,
84 fields => [(FID_INST_ID), (FID_PATRON_ID),
85 (FID_ITEM_ID), (FID_TERMINAL_PWD)],
86 },
71756501 87 2 => {
863db634 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 => {
71756501 101 1 => {
863db634 102 template => "CA18A18",
103 template_len => 37,
104 fields => [(FID_CURRENT_LOCN), (FID_INST_ID),
105 (FID_ITEM_ID), (FID_TERMINAL_PWD)],
106 },
71756501 107 2 => {
863db634 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 => {
71756501 120 1 => {
863db634 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 => {
71756501 132 1 => {
863db634 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 => {
71756501 143 1 => {
863db634 144 template => "",
145 template_len => 0,
146 fields => [],
147 }
148 }
149 },
150 (LOGIN) => {
151 name => "Login",
152 handler => \&handle_login,
153 protocol => {
71756501 154 2 => {
863db634 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 => {
71756501 166 2 => {
863db634 167 template => "A3A18A10",
e73ed630 168 template_len => 31,
863db634 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 => {
71756501 179 2 => {
863db634 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 => {
71756501 191 2 => {
31f325db
JS
192 template => "A18A2A2A3",
193 template_len => 25,
863db634 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 => {
71756501 205 2 => {
863db634 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 => {
71756501 217 2 => {
863db634 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 => {
71756501 230 2 => {
863db634 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 => {
71756501 242 2 => {
e29b1877 243 template => "AA18",
863db634 244 template_len => 19,
245 fields => [(FID_EXPIRATION), (FID_PICKUP_LOCN),
246 (FID_HOLD_TYPE), (FID_INST_ID),
fd03fa5f 247 (FID_PATRON_ID), (FID_PATRON_PWD),
248 (FID_ITEM_ID), (FID_TITLE_ID),
249 (FID_TERMINAL_PWD), (FID_FEE_ACK)],
863db634 250 }
251 }
252 },
253 (RENEW) => {
254 name => "Renew",
255 handler => \&handle_renew,
256 protocol => {
71756501 257 2 => {
863db634 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 => {
71756501 271 2 => {
863db634 272 template => "A18",
273 template_len => 18,
274 fields => [(FID_INST_ID), (FID_PATRON_ID),
b1e21e99 275 (FID_PATRON_PWD), (FID_TERMINAL_PWD),
276 (FID_FEE_ACK)],
863db634 277 }
278 }
279 }
280 );
281
282#
283# Now, initialize some of the missing bits of %handlers
284#
285foreach my $i (keys(%handlers)) {
71756501 286 if (!exists($handlers{$i}->{protocol}->{2})) {
863db634 287
71756501 288 $handlers{$i}->{protocol}->{2} = $handlers{$i}->{protocol}->{1};
863db634 289 }
290}
291
863db634 292sub 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.
71756501 305 $protocol_version = 2;
863db634 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})) {
71756501 313 syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
863db634 314 $msgtag, $protocol_version);
315 return(undef);
316 }
4cb9687f 317
863db634 318 bless $self, $class;
319
320 $self->{seqno} = $seqno;
321 $self->_initialize(substr($msg,2), $handlers{$msgtag});
322
323 return($self);
324}
325
326sub _initialize {
327 my ($self, $msg, $control_block) = @_;
328 my ($fs, $fn, $fe);
329 my $proto = $control_block->{protocol}->{$protocol_version};
4cb9687f 330
b398b624 331 $self->{name} = $control_block->{name};
863db634 332 $self->{handler} = $control_block->{handler};
4cb9687f 333
863db634 334 $self->{fields} = {};
335 $self->{fixed_fields} = [];
336
b398b624
JA
337 syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s...')", $self->{name}, substr($msg,0,20));
338
863db634 339
340 foreach my $field (@{$proto->{fields}}) {
b398b624 341 $self->{fields}->{$field} = undef;
863db634 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
e44a4262 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);
863db634 355
356 if (!exists($self->{fields}->{$fn})) {
357 syslog("LOG_WARNING",
e44a4262 358 "Unsupported field '%s' in %s message '%s'",
359 $fn, $self->{name}, $msg);
863db634 360 } elsif (defined($self->{fields}->{$fn})) {
361 syslog("LOG_WARNING",
e44a4262 362 "Duplicate field '%s' (previous value '%s') in %s message '%s'",
363 $fn, $self->{fields}->{$fn}, $self->{name}, $msg);
863db634 364 } else {
e44a4262 365 $self->{fields}->{$fn} = substr($field, 2);
863db634 366 }
367 }
4cb9687f 368
863db634 369 return($self);
370}
371
863db634 372sub 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
6b390026 433#
434# Patron status messages are produced in response to both
435# "Request Patron Status" and "Block Patron"
436#
9b5b7bb6 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#
6b390026 445sub build_patron_status {
446 my ($patron, $lang, $fields)= @_;
d9ac3dc4 447 $lang ||= '000';
b0afbc8f 448 my $patron_pwd = $fields->{(FID_PATRON_PWD)};
863db634 449 my $resp = (PATRON_STATUS_RESP);
863db634 450
b0afbc8f 451 if ($patron) {
6b390026 452 $resp .= patron_status_string($patron);
863db634 453 $resp .= $lang . Sip::timestamp();
3272f95c 454 $resp .= add_field(FID_PERSONAL_NAME, $patron->name);
863db634 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...
b0afbc8f 458 $resp .= add_field(FID_PATRON_ID, $patron->id);
71756501 459 if ($protocol_version >= 2) {
3272f95c 460 $resp .= add_field(FID_VALID_PATRON, 'Y');
8ed846f9
JA
461 # Patron password is a required field.
462 $resp .= add_field(FID_VALID_PATRON_PWD, sipbool($patron->check_password($patron_pwd)));
863db634 463 $resp .= maybe_add(FID_CURRENCY, $patron->currency);
464 $resp .= maybe_add(FID_FEE_AMT, $patron->fee_amount);
465 }
b1fd3e82 466
863db634 467 $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
468 $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
6b390026 469 } else {
b0afbc8f 470 # Invalid patron id. Report that the user has no privs.,
6b390026 471 # no personal name, and is invalid (if we're using 2.00)
3272f95c 472 $resp .= 'YYYY' . (' ' x 10) . $lang . Sip::timestamp();
473 $resp .= add_field(FID_PERSONAL_NAME, '');
6b390026 474
475 # the patron ID is invalid, but it's a required field, so
476 # just echo it back
3272f95c 477 $resp .= add_field(FID_PATRON_ID, $fields->{(FID_PATRON_ID)});
6b390026 478
71756501 479 if ($protocol_version >= 2) {
3272f95c 480 $resp .= add_field(FID_VALID_PATRON, 'N');
6b390026 481 }
482 }
483
3272f95c 484 $resp .= add_field(FID_INST_ID, $fields->{(FID_INST_ID)});
6b390026 485
486 return $resp;
487}
488
489sub handle_patron_status {
490 my ($self, $server) = @_;
c0415458 491 my $ils = $server->{ils};
6b390026 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
c0415458 501 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_patron_status");
863db634 502
53e76d18 503 $patron = $ils->find_patron($fields->{(FID_PATRON_ID)});
6b390026 504
505 $resp = build_patron_status($patron, $lang, $fields);
863db634 506
a032e892 507 $self->write_msg($resp);
863db634 508
509 return (PATRON_STATUS_REQ);
510}
511
863db634 512sub handle_checkout {
513 my ($self, $server) = @_;
514 my $account = $server->{account};
0e64db40 515 my $ils = $server->{ils};
516 my $inst = $ils->institution;
863db634 517 my ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date);
518 my $fields;
48ddb6a6 519 my ($patron_id, $item_id, $status, $fee_ack);
0e64db40 520 my ($item, $patron);
521 my $resp;
863db634 522
523 ($sc_renewal_policy, $no_block, $trans_date, $nb_due_date) =
524 @{$self->{fixed_fields}};
525 $fields = $self->{fields};
526
0e64db40 527 $patron_id = $fields->{(FID_PATRON_ID)};
c4e8ff65 528 $item_id = $fields->{(FID_ITEM_ID)};
48ddb6a6 529 $fee_ack = $fields->{(FID_FEE_ACK)};
4cb9687f 530
0e64db40 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
01764849 535 syslog("LOG_WARNING", "received no-block checkout from terminal '%s'",
6b390026 536 $account->{id});
0e64db40 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'
48ddb6a6 544 $status = $ils->checkout($patron_id, $item_id, $sc_renewal_policy, $fee_ack);
863db634 545 }
546
0e64db40 547
c4e8ff65 548 $item = $status->item;
0e64db40 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
c4e8ff65 566 $resp .= add_field(FID_INST_ID, $inst);
0e64db40 567 $resp .= add_field(FID_PATRON_ID, $patron_id);
c4e8ff65 568 $resp .= add_field(FID_ITEM_ID, $item_id);
0e64db40 569 $resp .= add_field(FID_TITLE_ID, $item->title_id);
4124fe80 570 $resp .= add_field(FID_DUE_DATE, $item->due_date);
0e64db40 571
572 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
573 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
574
71756501 575 if ($protocol_version >= 2) {
0e64db40 576 if ($ils->supports('security inhibit')) {
c4e8ff65 577 $resp .= add_field(FID_SECURITY_INHIBIT, $status->security_inhibit);
0e64db40 578 }
579 $resp .= maybe_add(FID_MEDIA_TYPE, $item->sip_media_type);
580 $resp .= maybe_add(FID_ITEM_PROPS, $item->sip_item_properties);
4cb9687f 581
0e64db40 582 # Financials
583 if ($status->fee_amount) {
c4e8ff65 584 $resp .= add_field(FID_FEE_AMT, $status->fee_amount);
0e64db40 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
a96db897 596 $resp = sprintf("120%sUN%s", sipbool($status->renew_ok), Sip::timestamp);
0e64db40 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
754dcff2 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 : '');
0e64db40 604 # Due date is required. Since it didn't get checked out,
605 # it's not due, so leave the date blank
3272f95c 606 $resp .= add_field(FID_DUE_DATE, '');
4cb9687f 607
0e64db40 608 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
609 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
4cb9687f 610
71756501 611 if ($protocol_version >= 2) {
0e64db40 612 # Is the patron ID valid?
613 $resp .= add_field(FID_VALID_PATRON, sipbool($patron));
4cb9687f 614
0e64db40 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 }
48ddb6a6
JS
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 }
0e64db40 627 }
863db634 628 }
629
a032e892 630 $self->write_msg($resp);
0e64db40 631 return(CHECKOUT);
863db634 632}
633
634sub handle_checkin {
635 my ($self, $server) = @_;
b4053dec 636 my $account = $server->{account};
2b7c247d 637 my $ils = $server->{ils};
b4053dec 638 my ($current_loc, $inst_id, $item_id, $terminal_pwd, $item_props, $cancel);
2b7c247d 639 my ($patron, $item, $status);
4cb9687f 640 my $resp = CHECKIN_RESP;
863db634 641
2b7c247d
JA
642 my ($no_block, $trans_date, $return_date) = @{$self->{fixed_fields}};
643 my $fields = $self->{fields};
863db634 644
b4053dec 645 $current_loc = $fields->{(FID_CURRENT_LOCN)};
e66c92b3
JA
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) };
863db634 650
c0415458 651 $ils->check_inst_id($inst_id, "handle_checkin");
b4053dec 652
653 if ($no_block eq 'Y') {
2b7c247d
JA
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);
b4053dec 657 } else {
1e264568 658 $status = $ils->checkin($item_id, $inst_id, $trans_date, $return_date, $current_loc, $item_props, $cancel);
863db634 659 }
660
4124fe80 661 $patron = $status->patron;
e66c92b3 662 $item = $status->item;
4124fe80 663
d12c871e 664 $resp .= $status->ok ? '1' : '0';
b4053dec 665 $resp .= $status->resensitize ? 'Y' : 'N';
53e76d18 666 if ($item && $ils->supports('magnetic media')) {
2b7c247d 667 $resp .= sipbool($item->magnetic);
b4053dec 668 } else {
2b7c247d
JA
669 # The item barcode was invalid or the system doesn't support
670 # the 'magnetic media' indicator
671 $resp .= 'U';
b4053dec 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);
53e76d18 677
678 if ($item) {
2b7c247d
JA
679 $resp .= add_field(FID_PERM_LOCN, $item->permanent_location);
680 $resp .= maybe_add(FID_TITLE_ID, $item->title_id);
53e76d18 681 }
b4053dec 682
71756501 683 if ($protocol_version >= 2) {
e66c92b3
JA
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 }
b4053dec 697 }
698
8ed846f9 699 $resp .= maybe_add(FID_ALERT_TYPE, $status->alert_type) if $status->alert;
b4053dec 700 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
701 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
702
a032e892 703 $self->write_msg($resp);
b4053dec 704
705 return(CHECKIN);
863db634 706}
707
708sub handle_block_patron {
709 my ($self, $server) = @_;
6b390026 710 my $account = $server->{account};
2b7c247d 711 my $ils = $server->{ils};
863db634 712 my ($card_retained, $trans_date);
6b390026 713 my ($inst_id, $blocked_card_msg, $patron_id, $terminal_pwd);
863db634 714 my $fields;
6b390026 715 my $resp;
716 my $patron;
863db634 717
718 ($card_retained, $trans_date) = @{$self->{fixed_fields}};
719 $fields = $self->{fields};
e66c92b3 720 $inst_id = $fields->{(FID_INST_ID)};
6b390026 721 $blocked_card_msg = $fields->{(FID_BLOCKED_CARD_MSG)};
e66c92b3
JA
722 $patron_id = $fields->{(FID_PATRON_ID)};
723 $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
863db634 724
6b390026 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.
863db634 728
c0415458 729 $ils->check_inst_id($inst_id, "block_patron");
863db634 730
53e76d18 731 $patron = $ils->find_patron($patron_id);
6b390026 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.
4cb9687f 736 #
6b390026 737 # Normally, the language is provided by the "Patron Status"
738 # fixed field, but since we're not responding to one of those
4cb9687f 739 # we'll just say, "Unspecified", as per the spec. Let the
740 # terminal default to something that, one hopes, will be
6b390026 741 # intelligible
32f2c2eb 742 my $language = $patron ? $patron->language : '000';
c4e38d30 743 if ($patron) {
2b7c247d
JA
744 # Valid patron id
745 $patron->block($card_retained, $blocked_card_msg);
c4e38d30 746 }
747
32f2c2eb 748 $resp = build_patron_status($patron, $language, $fields);
6b390026 749
a032e892 750 $self->write_msg($resp);
6b390026 751 return(BLOCK_PATRON);
863db634 752}
753
754sub handle_sc_status {
755 my ($self, $server) = @_;
71756501 756 my ($status, $print_width, $sc_protocol_version, $new_proto);
863db634 757
758 ($status, $print_width, $sc_protocol_version) = @{$self->{fixed_fields}};
759
71756501 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;
863db634 772 }
773
774 if ($status == SC_STATUS_PAPER) {
01764849 775 syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper",
863db634 776 $self->{account}->{id}, $self->{account}->{institution});
777 } elsif ($status == SC_STATUS_SHUTDOWN) {
01764849 778 syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down",
863db634 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
787sub handle_request_acs_resend {
788 my ($self, $server) = @_;
789
790 if (!$last_response) {
c4e8ff65
JA
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);
863db634 794 } elsif ((length($last_response) < 9)
c4e8ff65
JA
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");
863db634 801 } else {
c4e8ff65
JA
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));
863db634 805 }
863db634 806 return REQUEST_ACS_RESEND;
807}
808
809sub handle_login {
810 my ($self, $server) = @_;
811 my ($uid_algorithm, $pwd_algorithm);
812 my ($uid, $pwd);
a0140fe5 813 my $inst;
863db634 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) {
c4e8ff65
JA
824 syslog("LOG_ERR", "LOGIN: Can't cope with non-zero encryption methods: uid = $uid_algorithm, pwd = $pwd_algorithm");
825 $status = 0;
863db634 826 }
827
828 if (!exists($server->{config}->{accounts}->{$uid})) {
c4e8ff65
JA
829 syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'");
830 $status = 0;
863db634 831 } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) {
c4e8ff65
JA
832 syslog("LOG_WARNING", "MsgType::handle_login: Invalid password for login '$uid'");
833 $status = 0;
a0140fe5 834 } else {
c4e8ff65
JA
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 }
a0140fe5 854
c4e8ff65 855 $server->{ils} = $module->new($server->{institution}, $server->{account});
a0140fe5 856
c4e8ff65
JA
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 }
863db634 861 }
862
a032e892 863 $self->write_msg(LOGIN_RESP . $status);
863db634 864
865 return $status ? LOGIN : '';
866}
867
b4053dec 868#
b4053dec 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#
3272f95c 875sub summary_info {
53e76d18 876 my ($ils, $patron, $summary, $start, $end) = @_;
3272f95c 877 my $resp = '';
53e76d18 878 my $itemlist;
3272f95c 879 my $summary_type;
e73ed630 880 my ($func, $fid);
53e76d18 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 = (
c4e8ff65
JA
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 );
53e76d18 893
3272f95c 894
895 if (($summary_type = index($summary, 'Y')) == -1) {
c4e8ff65
JA
896 # No detailed information required
897 return '';
3272f95c 898 }
899
b4053dec 900 syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'",
901 $summary_type, $summary_map[$summary_type]->{fid});
902
e73ed630 903 $func = $summary_map[$summary_type]->{func};
c4e8ff65 904 $fid = $summary_map[$summary_type]->{fid};
53e76d18 905 $itemlist = &$func($patron, $start, $end);
3272f95c 906
53e76d18 907 syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist}));
908 foreach my $i (@{$itemlist}) {
c4e8ff65 909 $resp .= add_field($fid, $i);
3272f95c 910 }
e73ed630 911
912 return $resp;
3272f95c 913}
e73ed630 914
863db634 915sub handle_patron_info {
916 my ($self, $server) = @_;
53e76d18 917 my $ils = $server->{ils};
e73ed630 918 my ($lang, $trans_date, $summary) = @{$self->{fixed_fields}};
863db634 919 my $fields = $self->{fields};
3272f95c 920 my ($inst_id, $patron_id, $terminal_pwd, $patron_pwd, $start, $end);
921 my ($resp, $patron, $count);
36328df5 922 $lang ||= '000'; # unspecified
3272f95c 923
c4e8ff65
JA
924 $inst_id = $fields->{(FID_INST_ID)};
925 $patron_id = $fields->{(FID_PATRON_ID)};
3272f95c 926 $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
c4e8ff65
JA
927 $patron_pwd = $fields->{(FID_PATRON_PWD)};
928 $start = $fields->{(FID_START_ITEM)};
929 $end = $fields->{(FID_END_ITEM)};
3272f95c 930
53e76d18 931 $patron = $ils->find_patron($patron_id);
3272f95c 932
933 $resp = (PATRON_INFO_RESP);
b0afbc8f 934 if ($patron) {
59ea2125 935 $resp .= patron_status_string($patron);
36328df5
BE
936
937 $lang = $patron->language if $patron->language;
59ea2125
JA
938 $resp .= $lang . Sip::timestamp();
939
a3a17420
TB
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)});
9f763a42 942 $resp .= add_count('patron_info/charged_items', scalar @{$patron->charged_items(undef,undef,1)});
a3a17420
TB
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)});
59ea2125
JA
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,
b0afbc8f 977 sipbool($patron->check_password($patron_pwd)));
59ea2125 978 }
67ab4e79 979
59ea2125
JA
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
fd75f94f
TB
983 if ($patron->can('sip_expire')) {
984 $resp .= maybe_add(FID_PATRON_EXPIRE, $patron->sip_expire);
985 }
59ea2125
JA
986 $resp .= maybe_add(FID_PATRON_BIRTHDATE, $patron->sip_birthdate);
987 $resp .= maybe_add(FID_PATRON_CLASS, $patron->ptype);
2ef9a864 988
59ea2125
JA
989 # Custom protocol extension to report patron internet privileges
990 $resp .= maybe_add(FID_INET_PROFILE, $patron->inet_privileges);
337ce816 991
59ea2125 992 $resp .= maybe_add(FID_PATRON_INTERNAL_ID, $patron->internal_id); # another extension
1d00bd00 993
59ea2125
JA
994 $resp .= maybe_add(FID_SCREEN_MSG, $patron->screen_msg);
995 $resp .= maybe_add(FID_PRINT_LINE, $patron->print_line);
7ffae62b
TB
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 }
59ea2125
JA
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 }
3272f95c 1021 }
863db634 1022
3272f95c 1023 $resp .= add_field(FID_INST_ID, $server->{ils}->institution);
1024
a032e892 1025 $self->write_msg($resp);
3272f95c 1026
1027 return(PATRON_INFO);
863db634 1028}
1029
1030sub handle_end_patron_session {
1031 my ($self, $server) = @_;
f2211129 1032 my $ils = $server->{ils};
863db634 1033 my $trans_date;
4cb9687f 1034 my $fields = $self->{fields};
f2211129 1035 my $resp = END_SESSION_RESP;
1036 my ($status, $screen_msg, $print_line);
863db634 1037
863db634 1038 ($trans_date) = @{$self->{fixed_fields}};
863db634 1039
06bab7a7 1040 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_end_patron_session");
f2211129 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
a032e892 1053 $self->write_msg($resp);
f2211129 1054
1055 return(END_PATRON_SESSION);
863db634 1056}
1057
1058sub handle_fee_paid {
1059 my ($self, $server) = @_;
6e86531f 1060 my $ils = $server->{ils};
67d05dca 1061 my ($trans_date, $fee_type, $pay_type, $currency) = @{$self->{fixed_fields}};
863db634 1062 my $fields = $self->{fields};
b4053dec 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;
4cb9687f 1067
c4e8ff65
JA
1068 $fee_amt = $fields->{(FID_FEE_AMT)};
1069 $inst_id = $fields->{(FID_INST_ID)};
1070 $patron_id = $fields->{(FID_PATRON_ID)};
b4053dec 1071 $patron_pwd = $fields->{(FID_PATRON_PWD)};
c4e8ff65
JA
1072 $fee_id = $fields->{(FID_FEE_ID)};
1073 $trans_id = $fields->{(FID_TRANSACTION_ID)};
b4053dec 1074
6a5927f6 1075 $ils->check_inst_id($inst_id, "handle_fee_paid");
b4053dec 1076
6e86531f 1077 $status = $ils->pay_fee($patron_id, $patron_pwd, $fee_amt, $fee_type,
b4053dec 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
a032e892 1087 $self->write_msg($resp);
b4053dec 1088
1089 return(FEE_PAID);
863db634 1090}
1091
1092sub handle_item_information {
1093 my ($self, $server) = @_;
c0415458 1094 my $ils = $server->{ils};
863db634 1095 my $trans_date;
c0415458 1096 my $fields = $self->{fields};
1097 my $resp = ITEM_INFO_RESP;
1098 my $item;
863db634 1099
1100 ($trans_date) = @{$self->{fixed_fields}};
1101
c0415458 1102 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_item_information");
863db634 1103
c4e8ff65 1104 $item = $ils->find_item($fields->{(FID_ITEM_ID)});
c0415458 1105
1106 if (!defined($item)) {
4db37d67
JA
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, '');
c0415458 1115 } else {
4db37d67
JA
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);
b6a85c11
TB
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 }
863db634 1153 }
c0415458 1154
a032e892 1155 $self->write_msg($resp);
c0415458 1156
1157 return(ITEM_INFORMATION);
863db634 1158}
1159
1160sub handle_item_status_update {
1161 my ($self, $server) = @_;
d4a695e5 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;
863db634 1168
1169 ($trans_date) = @{$self->{fixed_fields}};
1170
d4a695e5 1171 $ils->check_inst_id($fields->{(FID_INST_ID)});
863db634 1172
c4e8ff65 1173 $item_id = $fields->{(FID_ITEM_ID)};
d4a695e5 1174 $item_props = $fields->{(FID_ITEM_PROPS)};
1175
1176 if (!defined($item_id)) {
c4e8ff65 1177 syslog("LOG_WARNING", "handle_item_status: received message without Item ID field");
d4a695e5 1178 } else {
c4e8ff65 1179 $item = $ils->find_item($item_id);
d4a695e5 1180 }
1181
1182 if (!$item) {
4db37d67
JA
1183 # Invalid Item ID
1184 $resp .= '0';
1185 $resp .= Sip::timestamp;
1186 $resp .= add_field(FID_ITEM_ID, $item_id);
d4a695e5 1187 } else {
4db37d67
JA
1188 # Valid Item ID
1189 $status = $item->status_update($item_props);
d4a695e5 1190
4db37d67
JA
1191 $resp .= $status->ok ? '1' : '0';
1192 $resp .= Sip::timestamp;
d4a695e5 1193
4db37d67
JA
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);
863db634 1197 }
4cb9687f 1198
d4a695e5 1199 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1200 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1201
a032e892 1202 $self->write_msg($resp);
d4a695e5 1203
1204 return(ITEM_STATUS_UPDATE);
863db634 1205}
1206
1207sub handle_patron_enable {
1208 my ($self, $server) = @_;
c4e8ff65 1209 my $ils = $server->{ils};
c4e38d30 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;
863db634 1214
1215 ($trans_date) = @{$self->{fixed_fields}};
c4e8ff65 1216 $patron_id = $fields->{(FID_PATRON_ID)};
c4e38d30 1217 $patron_pwd = $fields->{(FID_PATRON_PWD)};
863db634 1218
0bf2a2e0 1219 syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'",
c4e38d30 1220 $patron_id, $patron_pwd);
863db634 1221
53e76d18 1222 $patron = $ils->find_patron($patron_id);
c4e38d30 1223
f0e0c562 1224 if (!defined($patron)) {
c4e8ff65
JA
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');
c4e38d30 1231 } else {
c4e8ff65
JA
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);
863db634 1249 }
c4e38d30 1250
1251 $resp .= add_field(FID_INST_ID, $ils->institution);
1252
a032e892 1253 $self->write_msg($resp);
c4e38d30 1254
1255 return(PATRON_ENABLE);
863db634 1256}
1257
1258sub handle_hold {
1259 my ($self, $server) = @_;
e29b1877 1260 my $ils = $server->{ils};
863db634 1261 my ($hold_mode, $trans_date);
e29b1877 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;
863db634 1267
1268 ($hold_mode, $trans_date) = @{$self->{fixed_fields}};
1269
e29b1877 1270 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_hold");
863db634 1271
c4e8ff65
JA
1272 $patron_id = $fields->{(FID_PATRON_ID) };
1273 $expiry_date = $fields->{(FID_EXPIRATION) } || '';
e29b1877 1274 $pickup_locn = $fields->{(FID_PICKUP_LOCN)} || '';
c4e8ff65
JA
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';
e29b1877 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 {
0bf2a2e0 1295 syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'",
e29b1877 1296 $hold_mode, $server->{account}->{id});
53e76d18 1297 $status = $ils->Transaction::Hold;
4cb9687f 1298 $status->screen_msg("System error. Please contact library status");
e29b1877 1299 }
863db634 1300
4cb9687f 1301 $resp .= $status->ok;
0ad1f8c0 1302 $resp .= sipbool($status->item && $status->item->available($patron_id));
e29b1877 1303 $resp .= Sip::timestamp;
1304
1305 if ($status->ok) {
e29b1877 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 }
c4e8ff65 1312 $resp .= maybe_add(FID_QUEUE_POS, $status->queue_position);
e29b1877 1313 $resp .= maybe_add(FID_PICKUP_LOCN, $status->pickup_location);
c4e8ff65
JA
1314 $resp .= maybe_add(FID_ITEM_ID, $status->item->id);
1315 $resp .= maybe_add(FID_TITLE_ID, $status->item->title_id);
e29b1877 1316 } else {
1317 # Not ok. still need required fields
e29b1877 1318 $resp .= add_field(FID_PATRON_ID, $patron_id);
863db634 1319 }
e29b1877 1320
4124fe80 1321 $resp .= add_field(FID_INST_ID, $ils->institution);
e29b1877 1322 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1323 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1324
a032e892 1325 $self->write_msg($resp);
e29b1877 1326
1327 return(HOLD);
863db634 1328}
1329
1330sub handle_renew {
1331 my ($self, $server) = @_;
4124fe80 1332 my $ils = $server->{ils};
863db634 1333 my ($third_party, $no_block, $trans_date, $nb_due_date);
4124fe80 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;
863db634 1339
1340 ($third_party, $no_block, $trans_date, $nb_due_date) =
1341 @{$self->{fixed_fields}};
1342
4124fe80 1343 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew");
863db634 1344
4124fe80 1345 if ($no_block eq 'Y') {
0bf2a2e0 1346 syslog("LOG_WARNING",
4124fe80 1347 "handle_renew: recieved 'no block' renewal from terminal '%s'",
1348 $server->{account}->{id});
863db634 1349 }
1350
c4e8ff65 1351 $patron_id = $fields->{(FID_PATRON_ID)};
4124fe80 1352 $patron_pwd = $fields->{(FID_PATRON_PWD)};
c4e8ff65
JA
1353 $item_id = $fields->{(FID_ITEM_ID)};
1354 $title_id = $fields->{(FID_TITLE_ID)};
4124fe80 1355 $item_props = $fields->{(FID_ITEM_PROPS)};
c4e8ff65 1356 $fee_ack = $fields->{(FID_FEE_ACK)};
4124fe80 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;
c4e8ff65 1363 $item = $status->item;
4124fe80 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 }
c4e8ff65
JA
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 }
4124fe80 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?)
24a60324 1387 $resp .= '0NUN';
4124fe80 1388 $resp .= Sip::timestamp;
53e76d18 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
c4e8ff65
JA
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, '');
4124fe80 1396 }
1397
1398 if ($status->fee_amount) {
c4e8ff65
JA
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);
4124fe80 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
a032e892 1409 $self->write_msg($resp);
4124fe80 1410
1411 return(RENEW);
863db634 1412}
1413
1414sub handle_renew_all {
1415 my ($self, $server) = @_;
4cb9687f 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;
6a5927f6 1421 my (@renewed, @unrenewed);
4cb9687f 1422
1423 $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew_all");
863db634 1424
1425 ($trans_date) = @{$self->{fixed_fields}};
1426
c4e8ff65
JA
1427 $patron_id = $fields->{(FID_PATRON_ID)};
1428 $patron_pwd = $fields->{(FID_PATRON_PWD)};
4cb9687f 1429 $terminal_pwd = $fields->{(FID_TERMINAL_PWD)};
c4e8ff65 1430 $fee_ack = $fields->{(FID_FEE_ACK)};
863db634 1431
4cb9687f 1432 $status = $ils->renew_all($patron_id, $patron_pwd, $fee_ack);
1433
1434 $resp .= $status->ok ? '1' : '0';
b1e21e99 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
4cb9687f 1448 $resp .= Sip::timestamp;
1449 $resp .= add_field(FID_INST_ID, $ils->institution);
1450
6a5927f6 1451 $resp .= join('', map(add_field(FID_RENEWED_ITEMS, $_), @renewed));
1452 $resp .= join('', map(add_field(FID_UNRENEWED_ITEMS, $_), @unrenewed));
4cb9687f 1453
1454 $resp .= maybe_add(FID_SCREEN_MSG, $status->screen_msg);
1455 $resp .= maybe_add(FID_PRINT_LINE, $status->print_line);
1456
a032e892 1457 $self->write_msg($resp);
4cb9687f 1458
1459 return(RENEW_ALL);
863db634 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#
53e76d18 1468
1469my @message_type_names = (
1470 "patron status request",
1471 "checkout",
1472 "checkin",
1473 "block patron",
1474 "acs status",
20c43647 1475 "request sc/acs resend",
53e76d18 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
863db634 1488sub send_acs_status {
1489 my ($self, $server, $screen_msg, $print_line) = @_;
1490 my $msg = ACS_STATUS;
1491 my $account = $server->{account};
c4e8ff65
JA
1492 my $policy = $server->{policy};
1493 my $ils = $server->{ils};
863db634 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';
c4e8ff65
JA
1498 $checkout_ok = sipbool($ils->checkout_ok);
1499 $checkin_ok = sipbool($ils->checkin_ok);
b31c7f6e 1500 $ACS_renewal_policy = sipbool($policy->{renewal});
c4e8ff65
JA
1501 $status_update_ok = sipbool($ils->status_update_ok);
1502 $offline_ok = sipbool($ils->offline_ok);
863db634 1503 $timeout = sprintf("%03d", $policy->{timeout});
1504 $retries = sprintf("%03d", $policy->{retries});
1505
1506 if (length($timeout) != 3) {
c4e8ff65
JA
1507 syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", $timeout);
1508 $timeout = '000';
863db634 1509 }
1510
1511 if (length($retries) != 3) {
c4e8ff65
JA
1512 syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", $retries);
1513 $retries = '000';
863db634 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();
71756501 1519
1520 if ($protocol_version == 1) {
c4e8ff65 1521 $msg .= '1.00';
71756501 1522 } elsif ($protocol_version == 2) {
c4e8ff65 1523 $msg .= '2.00';
71756501 1524 } else {
c4e8ff65
JA
1525 syslog("LOG_ERR", 'Bad setting for $protocol_version, "%s" in send_acs_status', $protocol_version);
1526 $msg .= '1.00';
71756501 1527 }
863db634 1528
1529 # Institution ID
3272f95c 1530 $msg .= add_field(FID_INST_ID, $account->{institution});
863db634 1531
71756501 1532 if ($protocol_version >= 2) {
c4e8ff65
JA
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);
863db634 1547 }
1548
1549 $msg .= maybe_add(FID_SCREEN_MSG, $screen_msg);
1550
1551 if (defined($account->{print_width}) && defined($print_line)
c4e8ff65
JA
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});
863db634 1555 }
1556
1557 $msg .= maybe_add(FID_PRINT_LINE, $print_line);
1558
1559 # Do we want to tell the terminal its location?
1560
a032e892 1561 $self->write_msg($msg);
863db634 1562 return 1;
1563}
1564
1565#
2b7c247d 1566# patron_status_string: create the 14-char patron status
863db634 1567# string for the Patron Status message
1568#
6b390026 1569sub patron_status_string {
0e64db40 1570 my $patron = shift;
2b7c247d
JA
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 );
863db634 1588 return $patron_status;
1589}
1590
863db634 15911;