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

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

Return to bug 18768