Bug 5670: [Followup] Refactor .pl; error messages.
[koha.git] / misc / sip_cli_emulator.pl
blobf1799eee0f53b08615d9b3b76aca942e89e6d11f
1 #!/usr/bin/perl
3 # This file is part of Koha.
5 # Copyright (C) 2012-2013 ByWater Solutions
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Modern::Perl;
22 use Socket qw(:crlf);
23 use IO::Socket::INET;
24 use Getopt::Long;
26 use C4::SIP::Sip::Constants qw(:all);
27 use C4::SIP::Sip;
29 use constant { LANGUAGE => '001' };
31 my $help = 0;
33 my $host;
34 my $port = '6001';
36 my $login_user_id;
37 my $login_password;
38 my $location_code;
40 my $patron_identifier;
41 my $patron_password;
43 my $summary;
45 my $item_identifier;
47 my $fee_acknowledged = 0;
49 my $terminator = q{};
51 my @messages;
53 GetOptions(
54 "a|address|host|hostaddress=s" => \$host, # sip server ip
55 "p|port=s" => \$port, # sip server port
56 "su|sip_user=s" => \$login_user_id, # sip user
57 "sp|sip_pass=s" => \$login_password, # sip password
58 "l|location|location_code=s" => \$location_code, # sip location code
60 "patron=s" => \$patron_identifier, # patron cardnumber or login
61 "password=s" => \$patron_password, # patron's password
63 "i|item=s" => \$item_identifier,
65 "fa|fee-acknowledged" => \$fee_acknowledged,
67 "s|summary=s" => \$summary,
69 "t|terminator=s" => \$terminator,
71 "m|message=s" => \@messages,
73 'h|help|?' => \$help
76 if ( $help
77 || !$host
78 || !$login_user_id
79 || !$login_password
80 || !$location_code )
82 say &help();
83 exit();
86 $terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;
88 # Set perl to expect the same record terminator it is sending
89 $/ = $terminator;
91 my $transaction_date = C4::SIP::Sip::timestamp();
93 my $terminal_password = $login_password;
95 $| = 1;
96 print "Attempting socket connection to $host:$port...";
98 my $socket = IO::Socket::INET->new("$host:$port")
99 or die "failed! : $!\n";
100 say "connected!";
102 my $handlers = {
103 login => {
104 name => 'Login',
105 subroutine => \&build_login_command_message,
106 parameters => {
107 login_user_id => $login_user_id,
108 login_password => $login_password,
109 location_code => $location_code,
112 patron_status_request => {
113 name => 'Patron Status Request',
114 subroutine => \&build_patron_status_request_command_message,
115 parameters => {
116 transaction_date => $transaction_date,
117 institution_id => $location_code,
118 patron_identifier => $patron_identifier,
119 terminal_password => $terminal_password,
120 patron_password => $patron_password,
122 optional => [ 'patron_password', ],
124 patron_information => {
125 name => 'Patron Information',
126 subroutine => \&build_patron_information_command_message,
127 parameters => {
128 transaction_date => $transaction_date,
129 institution_id => $location_code,
130 patron_identifier => $patron_identifier,
131 terminal_password => $terminal_password,
132 patron_password => $patron_password,
133 summary => $summary,
135 optional => [ 'patron_password', 'summary' ],
137 item_information => {
138 name => 'Item Information',
139 subroutine => \&build_item_information_command_message,
140 parameters => {
141 transaction_date => $transaction_date,
142 institution_id => $location_code,
143 item_identifier => $item_identifier,
144 terminal_password => $terminal_password,
146 optional => [],
148 checkout => {
149 name => 'Checkout',
150 subroutine => \&build_checkout_command_message,
151 parameters => {
152 SC_renewal_policy => 'Y',
153 no_block => 'N',
154 transaction_date => $transaction_date,
155 nb_due_date => undef,
156 institution_id => $location_code,
157 patron_identifier => $patron_identifier,
158 item_identifier => $item_identifier,
159 terminal_password => $terminal_password,
160 item_properties => undef,
161 patron_password => $patron_password,
162 fee_acknowledged => $fee_acknowledged,
163 cancel => undef,
165 optional => [
166 'nb_due_date', # defaults to transaction date
167 'item_properties',
168 'patron_password',
169 'fee_acknowledged',
170 'cancel',
173 checkin => {
174 name => 'Checkin',
175 subroutine => \&build_checkin_command_message,
176 parameters => {
177 no_block => 'N',
178 transaction_date => $transaction_date,
179 return_date => $transaction_date,
180 current_location => $location_code,
181 institution_id => $location_code,
182 item_identifier => $item_identifier,
183 terminal_password => $terminal_password,
184 item_properties => undef,
185 cancel => undef,
187 optional => [
188 'return_date', # defaults to transaction date
189 'item_properties',
190 'patron_password',
191 'cancel',
194 renew => {
195 name => 'Renew',
196 subroutine => \&build_renew_command_message,
197 parameters => {
198 third_party_allowed => 'N',
199 no_block => 'N',
200 transaction_date => $transaction_date,
201 nb_due_date => undef,
202 institution_id => $location_code,
203 patron_identifier => $patron_identifier,
204 patron_password => $patron_password,
205 item_identifier => $item_identifier,
206 title_identifier => undef,
207 terminal_password => $terminal_password,
208 item_properties => undef,
209 fee_acknowledged => $fee_acknowledged,
211 optional => [
212 'nb_due_date', # defaults to transaction date
213 'patron_password',
214 'item_identifier',
215 'title_identifier',
216 'terminal_password',
217 'item_properties',
218 'fee_acknowledged',
223 my $data = run_command_message('login');
225 if ( $data =~ '^941' ) { ## we are logged in
226 foreach my $m (@messages) {
227 say "Trying '$m'";
229 my $data = run_command_message($m);
233 else {
234 say "Login Failed!";
237 sub build_command_message {
238 my ($message) = @_;
240 ##FIXME It would be much better to use exception handling so we aren't priting from subs
241 unless ( $handlers->{$message} ) {
242 say "$message is an unsupported command!";
243 return;
246 my $subroutine = $handlers->{$message}->{subroutine};
247 my $parameters = $handlers->{$message}->{parameters};
248 my %optional = map { $_ => 1 } @{ $handlers->{$message}->{optional} };
250 foreach my $key ( keys %$parameters ) {
251 unless ( $parameters->{$key} ) {
252 unless ( $optional{$key} ) {
253 say "$key is required for $message";
254 return;
259 return &$subroutine($parameters);
262 sub run_command_message {
263 my ($message) = @_;
265 my $command_message = build_command_message($message);
267 return unless $command_message;
269 say "SEND: $command_message";
270 print $socket $command_message . $terminator;
272 my $data = <$socket>;
274 say "READ: $data";
276 return $data;
279 sub build_login_command_message {
280 my ($params) = @_;
282 my $login_user_id = $params->{login_user_id};
283 my $login_password = $params->{login_password};
284 my $location_code = $params->{location_code};
286 return
287 LOGIN . "00"
288 . build_field( FID_LOGIN_UID, $login_user_id )
289 . build_field( FID_LOGIN_PWD, $login_password )
290 . build_field( FID_LOCATION_CODE, $location_code );
293 sub build_patron_status_request_command_message {
294 my ($params) = @_;
296 my $transaction_date = $params->{transaction_date};
297 my $institution_id = $params->{institution_id};
298 my $patron_identifier = $params->{patron_identifier};
299 my $terminal_password = $params->{terminal_password};
300 my $patron_password = $params->{patron_password};
302 return
303 PATRON_STATUS_REQ
304 . LANGUAGE
305 . $transaction_date
306 . build_field( FID_INST_ID, $institution_id )
307 . build_field( FID_PATRON_ID, $patron_identifier )
308 . build_field( FID_TERMINAL_PWD, $terminal_password )
309 . build_field( FID_PATRON_PWD, $patron_password );
312 sub build_patron_information_command_message {
313 my ($params) = @_;
315 my $transaction_date = $params->{transaction_date};
316 my $institution_id = $params->{institution_id};
317 my $patron_identifier = $params->{patron_identifier};
318 my $terminal_password = $params->{terminal_password};
319 my $patron_password = $params->{patron_password};
320 my $summary = $params->{summary};
322 $summary //= " ";
324 return
325 PATRON_INFO
326 . LANGUAGE
327 . $transaction_date
328 . $summary
329 . build_field( FID_INST_ID, $institution_id )
330 . build_field( FID_PATRON_ID, $patron_identifier )
331 . build_field( FID_TERMINAL_PWD, $terminal_password )
332 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } );
335 sub build_item_information_command_message {
336 my ($params) = @_;
338 my $transaction_date = $params->{transaction_date};
339 my $institution_id = $params->{institution_id};
340 my $item_identifier = $params->{item_identifier};
341 my $terminal_password = $params->{terminal_password};
343 return
344 ITEM_INFORMATION
345 . LANGUAGE
346 . $transaction_date
347 . build_field( FID_INST_ID, $institution_id )
348 . build_field( FID_ITEM_ID, $item_identifier )
349 . build_field( FID_TERMINAL_PWD, $terminal_password );
352 sub build_checkout_command_message {
353 my ($params) = @_;
355 my $SC_renewal_policy = $params->{SC_renewal_policy} || 'N';
356 my $no_block = $params->{no_block} || 'N';
357 my $transaction_date = $params->{transaction_date};
358 my $nb_due_date = $params->{nb_due_date};
359 my $institution_id = $params->{institution_id};
360 my $patron_identifier = $params->{patron_identifier};
361 my $item_identifier = $params->{item_identifier};
362 my $terminal_password = $params->{terminal_password};
363 my $item_properties = $params->{item_properties};
364 my $patron_password = $params->{patron_password};
365 my $fee_acknowledged = $params->{fee_acknowledged} || 'N';
366 my $cancel = $params->{cancel} || 'N';
368 $SC_renewal_policy = $SC_renewal_policy eq 'Y' ? 'Y' : 'N';
369 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
370 $fee_acknowledged = $fee_acknowledged eq 'Y' ? 'Y' : 'N';
371 $cancel = $cancel eq 'Y' ? 'Y' : 'N';
373 $nb_due_date ||= $transaction_date;
375 return
376 CHECKOUT
377 . $SC_renewal_policy
378 . $no_block
379 . $transaction_date
380 . $nb_due_date
381 . build_field( FID_INST_ID, $institution_id )
382 . build_field( FID_PATRON_ID, $patron_identifier )
383 . build_field( FID_ITEM_ID, $item_identifier )
384 . build_field( FID_TERMINAL_PWD, $terminal_password )
385 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
386 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } )
387 . build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } )
388 . build_field( FID_CANCEL, $cancel, { optional => 1 } );
391 sub build_checkin_command_message {
392 my ($params) = @_;
394 my $no_block = $params->{no_block} || 'N';
395 my $transaction_date = $params->{transaction_date};
396 my $return_date = $params->{return_date};
397 my $current_location = $params->{current_location};
398 my $institution_id = $params->{institution_id};
399 my $item_identifier = $params->{item_identifier};
400 my $terminal_password = $params->{terminal_password};
401 my $item_properties = $params->{item_properties};
402 my $cancel = $params->{cancel} || 'N';
404 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
405 $cancel = $cancel eq 'Y' ? 'Y' : 'N';
407 $return_date ||= $transaction_date;
409 return
410 CHECKIN
411 . $no_block
412 . $transaction_date
413 . $return_date
414 . build_field( FID_CURRENT_LOCN, $current_location )
415 . build_field( FID_INST_ID, $institution_id )
416 . build_field( FID_ITEM_ID, $item_identifier )
417 . build_field( FID_TERMINAL_PWD, $terminal_password )
418 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
419 . build_field( FID_CANCEL, $cancel, { optional => 1 } );
422 sub build_renew_command_message {
423 my ($params) = @_;
425 my $third_party_allowed = $params->{third_party_allowed} || 'N';
426 my $no_block = $params->{no_block} || 'N';
427 my $transaction_date = $params->{transaction_date};
428 my $nb_due_date = $params->{nb_due_date};
429 my $institution_id = $params->{institution_id};
430 my $patron_identifier = $params->{patron_identifier};
431 my $patron_password = $params->{patron_password};
432 my $item_identifier = $params->{item_identifier};
433 my $title_identifier = $params->{title_identifier};
434 my $terminal_password = $params->{terminal_password};
435 my $item_properties = $params->{item_properties};
436 my $fee_acknowledged = $params->{fee_acknowledged} || 'N';
438 $third_party_allowed = $third_party_allowed eq 'Y' ? 'Y' : 'N';
439 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
440 $fee_acknowledged = $fee_acknowledged eq 'Y' ? 'Y' : 'N';
442 $nb_due_date ||= $transaction_date;
444 return
445 RENEW
446 . $third_party_allowed
447 . $no_block
448 . $transaction_date
449 . $nb_due_date
450 . build_field( FID_INST_ID, $institution_id )
451 . build_field( FID_PATRON_ID, $patron_identifier )
452 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } )
453 . build_field( FID_ITEM_ID, $item_identifier )
454 . build_field( FID_TITLE_ID, $title_identifier )
455 . build_field( FID_TERMINAL_PWD, $terminal_password )
456 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
457 . build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } );
460 sub build_field {
461 my ( $field_identifier, $value, $params ) = @_;
463 $params //= {};
465 return q{} if ( $params->{optional} && !$value );
467 return $field_identifier . (($value) ? $value : '') . '|';
470 sub help {
471 say q/sip_cli_emulator.pl - SIP command line emulator
473 Test a SIP2 service by sending patron status and patron
474 information requests.
476 Usage:
477 sip_cli_emulator.pl [OPTIONS]
479 Options:
480 --help display help message
482 -a --address SIP server ip address or host name
483 -p --port SIP server port
485 -su --sip_user SIP server login username
486 -sp --sip_pass SIP server login password
488 -l --location SIP location code
490 --patron ILS patron cardnumber or username
491 --password ILS patron password
493 -s --summary Optionally define the patron information request summary field.
494 Please refer to the SIP2 protocol specification for details
496 --item ILS item identifier ( item barcode )
498 -t --terminator SIP2 message terminator, either CR, or CRLF
499 (defaults to CRLF)
501 -fa --fee-acknowledged Sends a confirmation of checkout fee
503 -m --message SIP2 message to execute
505 Implemented Messages:
506 patron_status_request
507 patron_information
508 item_information
509 checkout
510 checkin
511 renew