View | Details | Raw Unified | Return to bug 13159
Collapse All | Expand All

(-)a/C4/SIP/sip_cli_emulator.pl (+506 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright (C) 2012-2013 ByWater Solutions
6
#
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.
11
#
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.
16
#
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>.
19
20
use Modern::Perl;
21
22
use Socket qw(:crlf);
23
use IO::Socket::INET;
24
use Getopt::Long;
25
26
use Sip::Constants qw(:all);
27
28
use constant { LANGUAGE => '001' };
29
30
my $help = 0;
31
32
my $host;
33
my $port = '6001';
34
35
my $login_user_id;
36
my $login_password;
37
my $location_code;
38
39
my $patron_identifier;
40
my $patron_password;
41
42
my $item_identifier;
43
44
my $fee_acknowledged = 0;
45
46
my $terminator = q{};
47
48
my @messages;
49
50
GetOptions(
51
    "a|address|host|hostaddress=s" => \$host,              # sip server ip
52
    "p|port=s"                     => \$port,              # sip server port
53
    "su|sip_user=s"                => \$login_user_id,     # sip user
54
    "sp|sip_pass=s"                => \$login_password,    # sip password
55
    "l|location|location_code=s"   => \$location_code,     # sip location code
56
57
    "patron=s"   => \$patron_identifier,    # patron cardnumber or login
58
    "password=s" => \$patron_password,      # patron's password
59
60
    "i|item=s" => \$item_identifier,
61
62
    "fa|fee-acknowledged" => \$fee_acknowledged,
63
64
    "t|terminator=s" => \$terminator,
65
66
    "m|message=s" => \@messages,
67
68
    'h|help|?' => \$help
69
);
70
71
if (   $help
72
    || !$host
73
    || !$login_user_id
74
    || !$login_password
75
    || !$location_code )
76
{
77
    say &help();
78
    exit();
79
}
80
81
$terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;
82
83
# Set perl to expect the same record terminator it is sending
84
$/ = $terminator;
85
86
my ( $sec, $min, $hour, $day, $month, $year ) = localtime(time);
87
$year += 1900;
88
my $transaction_date = "$year$month$day    $hour$min$sec";
89
90
my $terminal_password = $login_password;
91
92
$| = 1;
93
print "Attempting socket connection to $host:$port...";
94
95
my $socket = IO::Socket::INET->new("$host:$port")
96
  or die "failed! : $!\n";
97
say "connected!";
98
99
my $handlers = {
100
    login => {
101
        name       => 'Login',
102
        subroutine => \&build_login_command_message,
103
        parameters => {
104
            login_user_id  => $login_user_id,
105
            login_password => $login_password,
106
            location_code  => $location_code,
107
        },
108
    },
109
    patron_status_request => {
110
        name       => 'Patron Status Request',
111
        subroutine => \&build_patron_status_request_command_message,
112
        parameters => {
113
            transaction_date  => $transaction_date,
114
            institution_id    => $location_code,
115
            patron_identifier => $patron_identifier,
116
            terminal_password => $terminal_password,
117
            patron_password   => $patron_password,
118
        },
119
        optional => [ 'patron_password', ],
120
    },
121
    patron_information => {
122
        name       => 'Patron Information',
123
        subroutine => \&build_patron_information_command_message,
124
        parameters => {
125
            transaction_date  => $transaction_date,
126
            institution_id    => $location_code,
127
            patron_identifier => $patron_identifier,
128
            terminal_password => $terminal_password,
129
            patron_password   => $patron_password,
130
        },
131
        optional => [ 'patron_password', ],
132
    },
133
    item_information => {
134
        name       => 'Item Information',
135
        subroutine => \&build_item_information_command_message,
136
        parameters => {
137
            transaction_date  => $transaction_date,
138
            institution_id    => $location_code,
139
            item_identifier   => $item_identifier,
140
            terminal_password => $terminal_password,
141
        },
142
        optional => [],
143
    },
144
    checkout => {
145
        name       => 'Checkout',
146
        subroutine => \&build_checkout_command_message,
147
        parameters => {
148
            SC_renewal_policy => 'Y',
149
            no_block          => 'N',
150
            transaction_date  => $transaction_date,
151
            nb_due_date       => undef,
152
            institution_id    => $location_code,
153
            patron_identifier => $patron_identifier,
154
            item_identifier   => $item_identifier,
155
            terminal_password => $terminal_password,
156
            item_properties   => undef,
157
            patron_password   => $patron_password,
158
            fee_acknowledged  => $fee_acknowledged,
159
            cancel            => undef,
160
        },
161
        optional => [
162
            'nb_due_date',    # defaults to transaction date
163
            'item_properties',
164
            'patron_password',
165
            'fee_acknowledged',
166
            'cancel',
167
        ],
168
    },
169
    checkin => {
170
        name       => 'Checkin',
171
        subroutine => \&build_checkin_command_message,
172
        parameters => {
173
            no_block          => 'N',
174
            transaction_date  => $transaction_date,
175
            return_date       => $transaction_date,
176
            current_location  => $location_code,
177
            institution_id    => $location_code,
178
            item_identifier   => $item_identifier,
179
            terminal_password => $terminal_password,
180
            item_properties   => undef,
181
            cancel            => undef,
182
        },
183
        optional => [
184
            'return_date',    # defaults to transaction date
185
            'item_properties',
186
            'patron_password',
187
            'cancel',
188
        ],
189
    },
190
    renew => {
191
        name       => 'Renew',
192
        subroutine => \&build_renew_command_message,
193
        parameters => {
194
            third_party_allowed => 'N',
195
            no_block            => 'N',
196
            transaction_date    => $transaction_date,
197
            nb_due_date         => undef,
198
            institution_id      => $location_code,
199
            patron_identifier   => $patron_identifier,
200
            patron_password     => $patron_password,
201
            item_identifier     => $item_identifier,
202
            title_identifier    => undef,
203
            terminal_password   => $terminal_password,
204
            item_properties     => undef,
205
            fee_acknowledged    => $fee_acknowledged,
206
        },
207
        optional => [
208
            'nb_due_date',    # defaults to transaction date
209
            'patron_password',
210
            'item_identifier',
211
            'title_identifier',
212
            'terminal_password',
213
            'item_properties',
214
            'fee_acknowledged',
215
        ],
216
    },
217
};
218
219
my $data = run_command_message('login');
220
221
if ( $data =~ '^941' ) {    ## we are logged in
222
    foreach my $m (@messages) {
223
        say "Trying '$m'";
224
225
        my $data = run_command_message($m);
226
227
    }
228
}
229
else {
230
    say "Login Failed!";
231
}
232
233
sub build_command_message {
234
    my ($message) = @_;
235
236
    ##FIXME It would be much better to use exception handling so we aren't priting from subs
237
    unless ( $handlers->{$message} ) {
238
        say "$message is an unsupported command!";
239
        return;
240
    }
241
242
    my $subroutine = $handlers->{$message}->{subroutine};
243
    my $parameters = $handlers->{$message}->{parameters};
244
    my %optional   = map { $_ => 1 } @{ $handlers->{$message}->{optional} };
245
246
    foreach my $key ( keys %$parameters ) {
247
        unless ( $parameters->{$key} ) {
248
            unless ( $optional{$key} ) {
249
                say "$key is required for $message";
250
                return;
251
            }
252
        }
253
    }
254
255
    return &$subroutine($parameters);
256
}
257
258
sub run_command_message {
259
    my ($message) = @_;
260
261
    my $command_message = build_command_message($message);
262
263
    return unless $command_message;
264
265
    say "SEND: $command_message";
266
    print $socket $command_message . $terminator;
267
268
    my $data = <$socket>;
269
270
    say "READ: $data";
271
272
    return $data;
273
}
274
275
sub build_login_command_message {
276
    my ($params) = @_;
277
278
    my $login_user_id  = $params->{login_user_id};
279
    my $login_password = $params->{login_password};
280
    my $location_code  = $params->{location_code};
281
282
    return
283
        LOGIN . "00"
284
      . build_field( FID_LOGIN_UID,     $login_user_id )
285
      . build_field( FID_LOGIN_PWD,     $login_password )
286
      . build_field( FID_LOCATION_CODE, $location_code );
287
}
288
289
sub build_patron_status_request_command_message {
290
    my ($params) = @_;
291
292
    my $transaction_date  = $params->{transaction_date};
293
    my $institution_id    = $params->{institution_id};
294
    my $patron_identifier = $params->{patron_identifier};
295
    my $terminal_password = $params->{terminal_password};
296
    my $patron_password   = $params->{patron_password};
297
298
    return
299
        PATRON_STATUS_REQ
300
      . LANGUAGE
301
      . $transaction_date
302
      . build_field( FID_INST_ID,      $institution_id )
303
      . build_field( FID_PATRON_ID,    $patron_identifier )
304
      . build_field( FID_TERMINAL_PWD, $terminal_password )
305
      . build_field( FID_PATRON_PWD,   $patron_password );
306
}
307
308
sub build_patron_information_command_message {
309
    my ($params) = @_;
310
311
    my $transaction_date  = $params->{transaction_date};
312
    my $institution_id    = $params->{institution_id};
313
    my $patron_identifier = $params->{patron_identifier};
314
    my $terminal_password = $params->{terminal_password};
315
    my $patron_password   = $params->{patron_password};
316
317
    my $summary = "          ";
318
319
    return
320
        PATRON_INFO
321
      . LANGUAGE
322
      . $transaction_date
323
      . $summary
324
      . build_field( FID_INST_ID,      $institution_id )
325
      . build_field( FID_PATRON_ID,    $patron_identifier )
326
      . build_field( FID_TERMINAL_PWD, $terminal_password )
327
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } );
328
}
329
330
sub build_item_information_command_message {
331
    my ($params) = @_;
332
333
    my $transaction_date  = $params->{transaction_date};
334
    my $institution_id    = $params->{institution_id};
335
    my $item_identifier   = $params->{item_identifier};
336
    my $terminal_password = $params->{terminal_password};
337
338
    return
339
        ITEM_INFORMATION
340
      . LANGUAGE
341
      . $transaction_date
342
      . build_field( FID_INST_ID,      $institution_id )
343
      . build_field( FID_ITEM_ID,      $item_identifier )
344
      . build_field( FID_TERMINAL_PWD, $terminal_password );
345
}
346
347
sub build_checkout_command_message {
348
    my ($params) = @_;
349
350
    my $SC_renewal_policy = $params->{SC_renewal_policy};
351
    my $no_block          = $params->{no_block};
352
    my $transaction_date  = $params->{transaction_date};
353
    my $nb_due_date       = $params->{nb_due_date};
354
    my $institution_id    = $params->{institution_id};
355
    my $patron_identifier = $params->{patron_identifier};
356
    my $item_identifier   = $params->{item_identifier};
357
    my $terminal_password = $params->{terminal_password};
358
    my $item_properties   = $params->{item_properties};
359
    my $patron_password   = $params->{patron_password};
360
    my $fee_acknowledged  = $params->{fee_acknowledged};
361
    my $cancel            = $params->{cancel};
362
363
    $SC_renewal_policy = $SC_renewal_policy ? 'Y' : 'N';
364
    $no_block          = $no_block          ? 'Y' : 'N';
365
    $fee_acknowledged  = $fee_acknowledged  ? 'Y' : 'N';
366
    $cancel            = $cancel            ? 'Y' : 'N';
367
368
    $nb_due_date ||= $transaction_date;
369
370
    return
371
        CHECKOUT
372
      . $SC_renewal_policy
373
      . $no_block
374
      . $transaction_date
375
      . $nb_due_date
376
      . build_field( FID_INST_ID,      $institution_id )
377
      . build_field( FID_PATRON_ID,    $patron_identifier )
378
      . build_field( FID_ITEM_ID,      $item_identifier )
379
      . build_field( FID_TERMINAL_PWD, $terminal_password )
380
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
381
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
382
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } )
383
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
384
}
385
386
sub build_checkin_command_message {
387
    my ($params) = @_;
388
389
    my $no_block          = $params->{no_block};
390
    my $transaction_date  = $params->{transaction_date};
391
    my $return_date       = $params->{return_date};
392
    my $current_location  = $params->{current_location};
393
    my $institution_id    = $params->{institution_id};
394
    my $item_identifier   = $params->{item_identifier};
395
    my $terminal_password = $params->{terminal_password};
396
    my $item_properties   = $params->{item_properties};
397
    my $cancel            = $params->{cancel};
398
399
    $no_block = $no_block ? 'Y' : 'N';
400
    $cancel   = $cancel   ? 'Y' : 'N';
401
402
    $return_date ||= $transaction_date;
403
404
    return
405
        CHECKIN
406
      . $no_block
407
      . $transaction_date
408
      . $return_date
409
      . build_field( FID_CURRENT_LOCN, $current_location )
410
      . build_field( FID_INST_ID,      $institution_id )
411
      . build_field( FID_ITEM_ID,      $item_identifier )
412
      . build_field( FID_TERMINAL_PWD, $terminal_password )
413
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
414
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
415
}
416
417
sub build_renew_command_message {
418
    my ($params) = @_;
419
420
    my $third_party_allowed = $params->{third_party_allowed};
421
    my $no_block            = $params->{no_block};
422
    my $transaction_date    = $params->{transaction_date};
423
    my $nb_due_date         = $params->{nb_due_date};
424
    my $institution_id      = $params->{institution_id};
425
    my $patron_identifier   = $params->{patron_identifier};
426
    my $patron_password     = $params->{patron_password};
427
    my $item_identifier     = $params->{item_identifier};
428
    my $title_identifier    = $params->{title_identifier};
429
    my $terminal_password   = $params->{terminal_password};
430
    my $item_properties     = $params->{item_properties};
431
    my $fee_acknowledged    = $params->{fee_acknowledged};
432
433
    $third_party_allowed = $third_party_allowed ? 'Y' : 'N';
434
    $no_block            = $no_block            ? 'Y' : 'N';
435
    $fee_acknowledged    = $fee_acknowledged    ? 'Y' : 'N';
436
437
    $nb_due_date ||= $transaction_date;
438
439
    return
440
        RENEW
441
      . $third_party_allowed
442
      . $no_block
443
      . $transaction_date
444
      . $nb_due_date
445
      . build_field( FID_INST_ID,      $institution_id )
446
      . build_field( FID_PATRON_ID,    $patron_identifier )
447
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
448
      . build_field( FID_ITEM_ID,      $item_identifier )
449
      . build_field( FID_TITLE_ID,     $title_identifier )
450
      . build_field( FID_TERMINAL_PWD, $terminal_password )
451
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
452
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } );
453
}
454
455
sub build_field {
456
    my ( $field_identifier, $value, $params ) = @_;
457
458
    $params //= {};
459
460
    return q{} if ( $params->{optional} && !$value );
461
462
    return $field_identifier . $value . '|';
463
}
464
465
sub help {
466
    say q/sip_cli_emulator.pl - SIP command line emulator
467
468
Test a SIP2 service by sending patron status and patron
469
information requests.
470
471
Usage:
472
  sip_cli_emulator.pl [OPTIONS]
473
474
Options:
475
  --help           display help message
476
477
  -a --address     SIP server ip address or host name
478
  -p --port        SIP server port
479
480
  -su --sip_user   SIP server login username
481
  -sp --sip_pass   SIP server login password
482
483
  -l --location    SIP location code
484
485
  --patron         ILS patron cardnumber or username
486
  --password       ILS patron password
487
488
  --item           ILS item identifier ( item barcode )
489
490
  -t --terminator  SIP2 message terminator, either CR, or CRLF
491
                   (defaults to CRLF)
492
493
  -fa --fee-acknowledged Sends a confirmation of checkout fee
494
495
  -m --message     SIP2 message to execute
496
497
  Implemented Messages:
498
    patron_status_request
499
    patron_information
500
    item_information
501
    checkout
502
    checkin
503
    renew
504
505
/
506
}
(-)a/misc/sip_cli_emulator.pl (-162 lines)
Lines 1-161 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright (C) 2012-2013 ByWater Solutions
6
#
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.
11
#
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.
16
#
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>.
19
20
use Modern::Perl;
21
22
use Socket qw(:crlf);
23
use IO::Socket::INET;
24
use Getopt::Long;
25
26
my $help = 0;
27
28
my $host;
29
my $port = '6001';
30
31
my $login_user_id;
32
my $login_password;
33
my $location_code;
34
35
my $patron_identifier;
36
my $patron_password;
37
38
my $terminator = q{};
39
40
GetOptions(
41
    "a|address|host|hostaddress=s" => \$host,              # sip server ip
42
    "p|port=s"                     => \$port,              # sip server port
43
    "su|sip_user=s"                => \$login_user_id,     # sip user
44
    "sp|sip_pass=s"                => \$login_password,    # sip password
45
    "l|location|location_code=s"   => \$location_code,     # sip location code
46
47
    "patron=s"   => \$patron_identifier,    # patron cardnumber or login
48
    "password=s" => \$patron_password,      # patron's password
49
50
    "t|terminator=s" => \$terminator,
51
52
    'h|help|?' => \$help
53
);
54
55
if (   $help
56
    || !$host
57
    || !$login_user_id
58
    || !$login_password
59
    || !$location_code
60
    || !$patron_identifier
61
    || !$patron_password )
62
{
63
    print &help();
64
    exit();
65
}
66
67
$terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;
68
69
# Set perl to expect the same record terminator it is sending
70
$/ = $terminator;
71
72
my ( $sec, $min, $hour, $day, $month, $year ) = localtime(time);
73
$year += 1900;
74
my $transaction_date = "$year$month$day    $hour$min$sec";
75
76
my $institution_id    = $location_code;
77
my $terminal_password = $login_password;
78
79
my $socket = IO::Socket::INET->new("$host:$port")
80
  or die "ERROR in Socket Creation host=$host port=$port : $!\n";
81
82
my $login_command = "9300CN$login_user_id|CO$login_password|CP$location_code|";
83
84
print "\nOUTBOUND: $login_command\n";
85
print $socket $login_command . $terminator;
86
87
my $data = <$socket>;
88
89
print "\nINBOUND: $data\n";
90
91
if ( $data =~ '^941' ) { ## we are logged in
92
93
    ## Patron Status Request
94
    print "\nTrying 'Patron Status Request'\n";
95
    my $patron_status_request = "23001"
96
      . $transaction_date
97
      . "AO"  . $institution_id
98
      . "|AA" . $patron_identifier
99
      . "|AC" . $terminal_password
100
      . "|AD" . $patron_password;
101
102
    print "\nOUTBOUND: $patron_status_request\n";
103
    print $socket $patron_status_request . $terminator;
104
105
    $data = <$socket>;
106
107
    print "\nINBOUND: $data\n";
108
109
    ## Patron Information
110
    print "\nTrying 'Patron Information'\n";
111
    my $summary = "          ";
112
    $patron_status_request = "63001"
113
      . $transaction_date
114
      . $summary
115
      . "AO"  . $institution_id
116
      . "|AA" . $patron_identifier
117
      . "|AC" . $terminal_password
118
      . "|AD" . $patron_password;
119
120
    print "\nOUTBOUND: $patron_status_request\n";
121
    print $socket $patron_status_request . $terminator;
122
123
    $data = <$socket>;
124
125
    print "\nINBOUND: $data\n";
126
127
}
128
else {
129
    print "\nLogin Failed!\n";
130
}
131
132
sub help {
133
    print
134
q/sip_cli_emulator.pl - SIP command line emulator
135
136
Test a SIP2 service by sending patron status and patron
137
information requests.
138
139
Usage:
140
  sip_cli_emulator.pl [OPTIONS]
141
142
Options:
143
  --help           display help message
144
145
  -a --address     SIP server ip address or host name
146
  -p --port        SIP server port
147
148
  -su --sip_user   SIP server login username
149
  -sp --sip_pass   SIP server login password
150
151
  -l --location    SIP location code
152
 
153
  --patron         ILS patron cardnumber or username
154
  --password       ILS patron password
155
156
  -t --terminator  SIP2 message terminator, either CR, or CRLF
157
                   (defaults to CRLF)
158
159
/
160
161
}
162
- 

Return to bug 13159