Bug 10120: (QA followup) avoid raising warnings on upgrade
[koha.git] / misc / sip_cli_emulator.pl
blobca8ba076365181b830dabc53503d6d9351f6ffa5
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 $item_identifier;
45 my $fee_acknowledged = 0;
47 my $terminator = q{};
49 my @messages;
51 GetOptions(
52 "a|address|host|hostaddress=s" => \$host, # sip server ip
53 "p|port=s" => \$port, # sip server port
54 "su|sip_user=s" => \$login_user_id, # sip user
55 "sp|sip_pass=s" => \$login_password, # sip password
56 "l|location|location_code=s" => \$location_code, # sip location code
58 "patron=s" => \$patron_identifier, # patron cardnumber or login
59 "password=s" => \$patron_password, # patron's password
61 "i|item=s" => \$item_identifier,
63 "fa|fee-acknowledged" => \$fee_acknowledged,
65 "t|terminator=s" => \$terminator,
67 "m|message=s" => \@messages,
69 'h|help|?' => \$help
72 if ( $help
73 || !$host
74 || !$login_user_id
75 || !$login_password
76 || !$location_code )
78 say &help();
79 exit();
82 $terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;
84 # Set perl to expect the same record terminator it is sending
85 $/ = $terminator;
87 my $transaction_date = C4::SIP::Sip::timestamp();
89 my $terminal_password = $login_password;
91 $| = 1;
92 print "Attempting socket connection to $host:$port...";
94 my $socket = IO::Socket::INET->new("$host:$port")
95 or die "failed! : $!\n";
96 say "connected!";
98 my $handlers = {
99 login => {
100 name => 'Login',
101 subroutine => \&build_login_command_message,
102 parameters => {
103 login_user_id => $login_user_id,
104 login_password => $login_password,
105 location_code => $location_code,
108 patron_status_request => {
109 name => 'Patron Status Request',
110 subroutine => \&build_patron_status_request_command_message,
111 parameters => {
112 transaction_date => $transaction_date,
113 institution_id => $location_code,
114 patron_identifier => $patron_identifier,
115 terminal_password => $terminal_password,
116 patron_password => $patron_password,
118 optional => [ 'patron_password', ],
120 patron_information => {
121 name => 'Patron Information',
122 subroutine => \&build_patron_information_command_message,
123 parameters => {
124 transaction_date => $transaction_date,
125 institution_id => $location_code,
126 patron_identifier => $patron_identifier,
127 terminal_password => $terminal_password,
128 patron_password => $patron_password,
130 optional => [ 'patron_password', ],
132 item_information => {
133 name => 'Item Information',
134 subroutine => \&build_item_information_command_message,
135 parameters => {
136 transaction_date => $transaction_date,
137 institution_id => $location_code,
138 item_identifier => $item_identifier,
139 terminal_password => $terminal_password,
141 optional => [],
143 checkout => {
144 name => 'Checkout',
145 subroutine => \&build_checkout_command_message,
146 parameters => {
147 SC_renewal_policy => 'Y',
148 no_block => 'N',
149 transaction_date => $transaction_date,
150 nb_due_date => undef,
151 institution_id => $location_code,
152 patron_identifier => $patron_identifier,
153 item_identifier => $item_identifier,
154 terminal_password => $terminal_password,
155 item_properties => undef,
156 patron_password => $patron_password,
157 fee_acknowledged => $fee_acknowledged,
158 cancel => undef,
160 optional => [
161 'nb_due_date', # defaults to transaction date
162 'item_properties',
163 'patron_password',
164 'fee_acknowledged',
165 'cancel',
168 checkin => {
169 name => 'Checkin',
170 subroutine => \&build_checkin_command_message,
171 parameters => {
172 no_block => 'N',
173 transaction_date => $transaction_date,
174 return_date => $transaction_date,
175 current_location => $location_code,
176 institution_id => $location_code,
177 item_identifier => $item_identifier,
178 terminal_password => $terminal_password,
179 item_properties => undef,
180 cancel => undef,
182 optional => [
183 'return_date', # defaults to transaction date
184 'item_properties',
185 'patron_password',
186 'cancel',
189 renew => {
190 name => 'Renew',
191 subroutine => \&build_renew_command_message,
192 parameters => {
193 third_party_allowed => 'N',
194 no_block => 'N',
195 transaction_date => $transaction_date,
196 nb_due_date => undef,
197 institution_id => $location_code,
198 patron_identifier => $patron_identifier,
199 patron_password => $patron_password,
200 item_identifier => $item_identifier,
201 title_identifier => undef,
202 terminal_password => $terminal_password,
203 item_properties => undef,
204 fee_acknowledged => $fee_acknowledged,
206 optional => [
207 'nb_due_date', # defaults to transaction date
208 'patron_password',
209 'item_identifier',
210 'title_identifier',
211 'terminal_password',
212 'item_properties',
213 'fee_acknowledged',
218 my $data = run_command_message('login');
220 if ( $data =~ '^941' ) { ## we are logged in
221 foreach my $m (@messages) {
222 say "Trying '$m'";
224 my $data = run_command_message($m);
228 else {
229 say "Login Failed!";
232 sub build_command_message {
233 my ($message) = @_;
235 ##FIXME It would be much better to use exception handling so we aren't priting from subs
236 unless ( $handlers->{$message} ) {
237 say "$message is an unsupported command!";
238 return;
241 my $subroutine = $handlers->{$message}->{subroutine};
242 my $parameters = $handlers->{$message}->{parameters};
243 my %optional = map { $_ => 1 } @{ $handlers->{$message}->{optional} };
245 foreach my $key ( keys %$parameters ) {
246 unless ( $parameters->{$key} ) {
247 unless ( $optional{$key} ) {
248 say "$key is required for $message";
249 return;
254 return &$subroutine($parameters);
257 sub run_command_message {
258 my ($message) = @_;
260 my $command_message = build_command_message($message);
262 return unless $command_message;
264 say "SEND: $command_message";
265 print $socket $command_message . $terminator;
267 my $data = <$socket>;
269 say "READ: $data";
271 return $data;
274 sub build_login_command_message {
275 my ($params) = @_;
277 my $login_user_id = $params->{login_user_id};
278 my $login_password = $params->{login_password};
279 my $location_code = $params->{location_code};
281 return
282 LOGIN . "00"
283 . build_field( FID_LOGIN_UID, $login_user_id )
284 . build_field( FID_LOGIN_PWD, $login_password )
285 . build_field( FID_LOCATION_CODE, $location_code );
288 sub build_patron_status_request_command_message {
289 my ($params) = @_;
291 my $transaction_date = $params->{transaction_date};
292 my $institution_id = $params->{institution_id};
293 my $patron_identifier = $params->{patron_identifier};
294 my $terminal_password = $params->{terminal_password};
295 my $patron_password = $params->{patron_password};
297 return
298 PATRON_STATUS_REQ
299 . LANGUAGE
300 . $transaction_date
301 . build_field( FID_INST_ID, $institution_id )
302 . build_field( FID_PATRON_ID, $patron_identifier )
303 . build_field( FID_TERMINAL_PWD, $terminal_password )
304 . build_field( FID_PATRON_PWD, $patron_password );
307 sub build_patron_information_command_message {
308 my ($params) = @_;
310 my $transaction_date = $params->{transaction_date};
311 my $institution_id = $params->{institution_id};
312 my $patron_identifier = $params->{patron_identifier};
313 my $terminal_password = $params->{terminal_password};
314 my $patron_password = $params->{patron_password};
316 my $summary = " ";
318 return
319 PATRON_INFO
320 . LANGUAGE
321 . $transaction_date
322 . $summary
323 . build_field( FID_INST_ID, $institution_id )
324 . build_field( FID_PATRON_ID, $patron_identifier )
325 . build_field( FID_TERMINAL_PWD, $terminal_password )
326 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } );
329 sub build_item_information_command_message {
330 my ($params) = @_;
332 my $transaction_date = $params->{transaction_date};
333 my $institution_id = $params->{institution_id};
334 my $item_identifier = $params->{item_identifier};
335 my $terminal_password = $params->{terminal_password};
337 return
338 ITEM_INFORMATION
339 . LANGUAGE
340 . $transaction_date
341 . build_field( FID_INST_ID, $institution_id )
342 . build_field( FID_ITEM_ID, $item_identifier )
343 . build_field( FID_TERMINAL_PWD, $terminal_password );
346 sub build_checkout_command_message {
347 my ($params) = @_;
349 my $SC_renewal_policy = $params->{SC_renewal_policy} || 'N';
350 my $no_block = $params->{no_block} || 'N';
351 my $transaction_date = $params->{transaction_date};
352 my $nb_due_date = $params->{nb_due_date};
353 my $institution_id = $params->{institution_id};
354 my $patron_identifier = $params->{patron_identifier};
355 my $item_identifier = $params->{item_identifier};
356 my $terminal_password = $params->{terminal_password};
357 my $item_properties = $params->{item_properties};
358 my $patron_password = $params->{patron_password};
359 my $fee_acknowledged = $params->{fee_acknowledged} || 'N';
360 my $cancel = $params->{cancel} || 'N';
362 $SC_renewal_policy = $SC_renewal_policy eq 'Y' ? 'Y' : 'N';
363 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
364 $fee_acknowledged = $fee_acknowledged eq 'Y' ? 'Y' : 'N';
365 $cancel = $cancel eq 'Y' ? 'Y' : 'N';
367 $nb_due_date ||= $transaction_date;
369 return
370 CHECKOUT
371 . $SC_renewal_policy
372 . $no_block
373 . $transaction_date
374 . $nb_due_date
375 . build_field( FID_INST_ID, $institution_id )
376 . build_field( FID_PATRON_ID, $patron_identifier )
377 . build_field( FID_ITEM_ID, $item_identifier )
378 . build_field( FID_TERMINAL_PWD, $terminal_password )
379 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
380 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } )
381 . build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } )
382 . build_field( FID_CANCEL, $cancel, { optional => 1 } );
385 sub build_checkin_command_message {
386 my ($params) = @_;
388 my $no_block = $params->{no_block} || 'N';
389 my $transaction_date = $params->{transaction_date};
390 my $return_date = $params->{return_date};
391 my $current_location = $params->{current_location};
392 my $institution_id = $params->{institution_id};
393 my $item_identifier = $params->{item_identifier};
394 my $terminal_password = $params->{terminal_password};
395 my $item_properties = $params->{item_properties};
396 my $cancel = $params->{cancel} || 'N';
398 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
399 $cancel = $cancel eq 'Y' ? 'Y' : 'N';
401 $return_date ||= $transaction_date;
403 return
404 CHECKIN
405 . $no_block
406 . $transaction_date
407 . $return_date
408 . build_field( FID_CURRENT_LOCN, $current_location )
409 . build_field( FID_INST_ID, $institution_id )
410 . build_field( FID_ITEM_ID, $item_identifier )
411 . build_field( FID_TERMINAL_PWD, $terminal_password )
412 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
413 . build_field( FID_CANCEL, $cancel, { optional => 1 } );
416 sub build_renew_command_message {
417 my ($params) = @_;
419 my $third_party_allowed = $params->{third_party_allowed} || 'N';
420 my $no_block = $params->{no_block} || 'N';
421 my $transaction_date = $params->{transaction_date};
422 my $nb_due_date = $params->{nb_due_date};
423 my $institution_id = $params->{institution_id};
424 my $patron_identifier = $params->{patron_identifier};
425 my $patron_password = $params->{patron_password};
426 my $item_identifier = $params->{item_identifier};
427 my $title_identifier = $params->{title_identifier};
428 my $terminal_password = $params->{terminal_password};
429 my $item_properties = $params->{item_properties};
430 my $fee_acknowledged = $params->{fee_acknowledged} || 'N';
432 $third_party_allowed = $third_party_allowed eq 'Y' ? 'Y' : 'N';
433 $no_block = $no_block eq 'Y' ? 'Y' : 'N';
434 $fee_acknowledged = $fee_acknowledged eq 'Y' ? 'Y' : 'N';
436 $nb_due_date ||= $transaction_date;
438 return
439 RENEW
440 . $third_party_allowed
441 . $no_block
442 . $transaction_date
443 . $nb_due_date
444 . build_field( FID_INST_ID, $institution_id )
445 . build_field( FID_PATRON_ID, $patron_identifier )
446 . build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } )
447 . build_field( FID_ITEM_ID, $item_identifier )
448 . build_field( FID_TITLE_ID, $title_identifier )
449 . build_field( FID_TERMINAL_PWD, $terminal_password )
450 . build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
451 . build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } );
454 sub build_field {
455 my ( $field_identifier, $value, $params ) = @_;
457 $params //= {};
459 return q{} if ( $params->{optional} && !$value );
461 return $field_identifier . (($value) ? $value : '') . '|';
464 sub help {
465 say q/sip_cli_emulator.pl - SIP command line emulator
467 Test a SIP2 service by sending patron status and patron
468 information requests.
470 Usage:
471 sip_cli_emulator.pl [OPTIONS]
473 Options:
474 --help display help message
476 -a --address SIP server ip address or host name
477 -p --port SIP server port
479 -su --sip_user SIP server login username
480 -sp --sip_pass SIP server login password
482 -l --location SIP location code
484 --patron ILS patron cardnumber or username
485 --password ILS patron password
487 --item ILS item identifier ( item barcode )
489 -t --terminator SIP2 message terminator, either CR, or CRLF
490 (defaults to CRLF)
492 -fa --fee-acknowledged Sends a confirmation of checkout fee
494 -m --message SIP2 message to execute
496 Implemented Messages:
497 patron_status_request
498 patron_information
499 item_information
500 checkout
501 checkin
502 renew