Attachment #35163 for bug #13159

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




#!/usr/bin/perl

# This file is part of Koha.
#
# Copyright (C) 2012-2013 ByWater Solutions
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use Socket qw(:crlf);
use IO::Socket::INET;
use Getopt::Long;

use Sip::Constants qw(:all);

use constant { LANGUAGE => '001' };

my $help = 0;

my $host;
my $port = '6001';

my $login_user_id;
my $login_password;
my $location_code;

my $patron_identifier;
my $patron_password;

my $item_identifier;

my $fee_acknowledged = 0;

my $terminator = q{};

my @messages;

GetOptions(
    "a|address|host|hostaddress=s" => \$host,              # sip server ip
    "p|port=s"                     => \$port,              # sip server port
    "su|sip_user=s"                => \$login_user_id,     # sip user
    "sp|sip_pass=s"                => \$login_password,    # sip password
    "l|location|location_code=s"   => \$location_code,     # sip location code

    "patron=s"   => \$patron_identifier,    # patron cardnumber or login
    "password=s" => \$patron_password,      # patron's password

    "i|item=s" => \$item_identifier,

    "fa|fee-acknowledged" => \$fee_acknowledged,

    "t|terminator=s" => \$terminator,

    "m|message=s" => \@messages,

    'h|help|?' => \$help
);

if (   $help
    || !$host
    || !$login_user_id
    || !$login_password
    || !$location_code )
{
    say &help();
    exit();
}

$terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;

# Set perl to expect the same record terminator it is sending
$/ = $terminator;

my ( $sec, $min, $hour, $day, $month, $year ) = localtime(time);
$year += 1900;
my $transaction_date = "$year$month$day    $hour$min$sec";

my $terminal_password = $login_password;

$| = 1;
print "Attempting socket connection to $host:$port...";

my $socket = IO::Socket::INET->new("$host:$port")
  or die "failed! : $!\n";
say "connected!";

my $handlers = {
    login => {
        name       => 'Login',
        subroutine => \&build_login_command_message,
        parameters => {
            login_user_id  => $login_user_id,
            login_password => $login_password,
            location_code  => $location_code,
        },
    },
    patron_status_request => {
        name       => 'Patron Status Request',
        subroutine => \&build_patron_status_request_command_message,
        parameters => {
            transaction_date  => $transaction_date,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            terminal_password => $terminal_password,
            patron_password   => $patron_password,
        },
        optional => [
            'patron_password',
        ],
    },
    patron_information => {
        name       => 'Patron Information',
        subroutine => \&build_patron_information_command_message,
        parameters => {
            transaction_date  => $transaction_date,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            terminal_password => $terminal_password,
            patron_password   => $patron_password,
        },
        optional => [
            'patron_password',
        ],
    },
    checkout => {
        name       => 'Checkout',
        subroutine => \&build_checkout_command_message,
        parameters => {
            SC_renewal_policy => 'Y',
            no_block          => 'N',
            transaction_date  => $transaction_date,
            nb_due_date       => undef,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            item_identifier   => $item_identifier,
            terminal_password => $terminal_password,
            item_properties   => undef,
            patron_password   => $patron_password,
            fee_acknowledged  => $fee_acknowledged,
            cancel            => undef,
        },
        optional => [
            'nb_due_date',    # defaults to transaction date
            'item_properties',
            'patron_password',
            'fee_acknowledged',
            'cancel',
        ],
    },
    checkin => {
        name       => 'Checkin',
        subroutine => \&build_checkin_command_message,
        parameters => {
            no_block          => 'N',
            transaction_date  => $transaction_date,
            return_date       => $transaction_date,
            current_location  => $location_code,
            institution_id    => $location_code,
            item_identifier   => $item_identifier,
            terminal_password => $terminal_password,
            item_properties   => undef,
            cancel            => undef,
        },
        optional => [
            'return_date',    # defaults to transaction date
            'item_properties',
            'patron_password',
            'cancel',
        ],
    },
    renew => {
        name       => 'Renew',
        subroutine => \&build_renew_command_message,
        parameters => {
            third_party_allowed => 'N',
            no_block            => 'N',
            transaction_date    => $transaction_date,
            nb_due_date         => undef,
            institution_id      => $location_code,
            patron_identifier   => $patron_identifier,
            patron_password     => $patron_password,
            item_identifier     => $item_identifier,
            title_identifier    => undef,
            terminal_password   => $terminal_password,
            item_properties     => undef,
            fee_acknowledged    => $fee_acknowledged,
        },
        optional => [
            'nb_due_date',    # defaults to transaction date
            'patron_password',
            'item_identifier',
            'title_identifier',
            'terminal_password',
            'item_properties',
            'fee_acknowledged',
        ],
    },
};

my $data = run_command_message('login');

if ( $data =~ '^941' ) {    ## we are logged in
    foreach my $m (@messages) {
        say "Trying '$m'";

        my $data = run_command_message($m);

    }
}
else {
    say "Login Failed!";
}

sub build_command_message {
    my ($message) = @_;

    ##FIXME It would be much better to use exception handling so we aren't priting from subs
    unless ( $handlers->{$message} ) {
        say "$message is an unsupported command!";
        return;
    }

    my $subroutine = $handlers->{$message}->{subroutine};
    my $parameters = $handlers->{$message}->{parameters};
    my %optional   = map { $_ => 1 } @{ $handlers->{$message}->{optional} };

    foreach my $key ( keys %$parameters ) {
        unless ( $parameters->{$key} ) {
            unless ( $optional{$key} ) {
                say "$key is required for $message";
                return;
            }
        }
    }

    return &$subroutine($parameters);
}

sub run_command_message {
    my ($message) = @_;

    my $command_message = build_command_message($message);

    return unless $command_message;

    say "SEND: $command_message";
    print $socket $command_message . $terminator;

    my $data = <$socket>;

    say "READ: $data";

    return $data;
}

sub build_login_command_message {
    my ($params) = @_;

    my $login_user_id  = $params->{login_user_id};
    my $login_password = $params->{login_password};
    my $location_code  = $params->{location_code};

    return
        LOGIN . "00"
      . build_field( FID_LOGIN_UID,     $login_user_id )
      . build_field( FID_LOGIN_PWD,     $login_password )
      . build_field( FID_LOCATION_CODE, $location_code );
}

sub build_patron_status_request_command_message {
    my ($params) = @_;

    my $transaction_date  = $params->{transaction_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $terminal_password = $params->{terminal_password};
    my $patron_password   = $params->{patron_password};

    return
        PATRON_STATUS_REQ
      . LANGUAGE
      . $transaction_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_PATRON_PWD,   $patron_password );
}

sub build_patron_information_command_message {
    my ($params) = @_;

    my $transaction_date  = $params->{transaction_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $terminal_password = $params->{terminal_password};
    my $patron_password   = $params->{patron_password};

    my $summary = "          ";

    return
        PATRON_INFO
      . LANGUAGE
      . $transaction_date
      . $summary
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } );
}

sub build_checkout_command_message {
    my ($params) = @_;

    my $SC_renewal_policy = $params->{SC_renewal_policy};
    my $no_block          = $params->{no_block};
    my $transaction_date  = $params->{transaction_date};
    my $nb_due_date       = $params->{nb_due_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $item_identifier   = $params->{item_identifier};
    my $terminal_password = $params->{terminal_password};
    my $item_properties   = $params->{item_properties};
    my $patron_password   = $params->{patron_password};
    my $fee_acknowledged  = $params->{fee_acknowledged};
    my $cancel            = $params->{cancel};

    $SC_renewal_policy = $SC_renewal_policy ? 'Y' : 'N';
    $no_block          = $no_block          ? 'Y' : 'N';
    $fee_acknowledged  = $fee_acknowledged  ? 'Y' : 'N';
    $cancel            = $cancel            ? 'Y' : 'N';

    $nb_due_date ||= $transaction_date;

    return
        CHECKOUT
      . $SC_renewal_policy
      . $no_block
      . $transaction_date
      . $nb_due_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } )
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
}

sub build_checkin_command_message {
    my ($params) = @_;

    my $no_block          = $params->{no_block};
    my $transaction_date  = $params->{transaction_date};
    my $return_date       = $params->{return_date};
    my $current_location  = $params->{current_location};
    my $institution_id    = $params->{institution_id};
    my $item_identifier   = $params->{item_identifier};
    my $terminal_password = $params->{terminal_password};
    my $item_properties   = $params->{item_properties};
    my $cancel            = $params->{cancel};

    $no_block = $no_block ? 'Y' : 'N';
    $cancel   = $cancel   ? 'Y' : 'N';

    $return_date ||= $transaction_date;

    return
        CHECKIN
      . $no_block
      . $transaction_date
      . $return_date
      . build_field( FID_CURRENT_LOCN, $current_location )
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
}

sub build_renew_command_message {
    my ($params) = @_;

    my $third_party_allowed = $params->{third_party_allowed};
    my $no_block            = $params->{no_block};
    my $transaction_date    = $params->{transaction_date};
    my $nb_due_date         = $params->{nb_due_date};
    my $institution_id      = $params->{institution_id};
    my $patron_identifier   = $params->{patron_identifier};
    my $patron_password     = $params->{patron_password};
    my $item_identifier     = $params->{item_identifier};
    my $title_identifier    = $params->{title_identifier};
    my $terminal_password   = $params->{terminal_password};
    my $item_properties     = $params->{item_properties};
    my $fee_acknowledged    = $params->{fee_acknowledged};

    $third_party_allowed = $third_party_allowed ? 'Y' : 'N';
    $no_block            = $no_block            ? 'Y' : 'N';
    $fee_acknowledged    = $fee_acknowledged    ? 'Y' : 'N';

    $nb_due_date ||= $transaction_date;

    return
        RENEW
      . $third_party_allowed
      . $no_block
      . $transaction_date
      . $nb_due_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TITLE_ID,     $title_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } );
}

sub build_field {
    my ( $field_identifier, $value, $params ) = @_;

    $params //= {};

    return q{} if ( $params->{optional} && !$value );

    return $field_identifier . $value . '|';
}

sub help {
    say q/sip_cli_emulator.pl - SIP command line emulator

Test a SIP2 service by sending patron status and patron
information requests.

Usage:
  sip_cli_emulator.pl [OPTIONS]

Options:
  --help           display help message

  -a --address     SIP server ip address or host name
  -p --port        SIP server port

  -su --sip_user   SIP server login username
  -sp --sip_pass   SIP server login password

  -l --location    SIP location code

  --patron         ILS patron cardnumber or username
  --password       ILS patron password

  --item           ILS item identifier ( item barcode )

  -t --terminator  SIP2 message terminator, either CR, or CRLF
                   (defaults to CRLF)

  -fa --fee-acknowledged Sends a confirmation of checkout fee

  -m --message     SIP2 message to execute

  Implemented Messages:
    patron_status_request
    patron_information
    checkout
    checkin
    renew

/
}




#!/usr/bin/perl

# This file is part of Koha.
#
# Copyright (C) 2012-2013 ByWater Solutions
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use Socket qw(:crlf);
use IO::Socket::INET;
use Getopt::Long;

my $help = 0;

my $host;
my $port = '6001';

my $login_user_id;
my $login_password;
my $location_code;

my $patron_identifier;
my $patron_password;

my $terminator = q{};

GetOptions(
    "a|address|host|hostaddress=s" => \$host,              # sip server ip
    "p|port=s"                     => \$port,              # sip server port
    "su|sip_user=s"                => \$login_user_id,     # sip user
    "sp|sip_pass=s"                => \$login_password,    # sip password
    "l|location|location_code=s"   => \$location_code,     # sip location code

    "patron=s"   => \$patron_identifier,    # patron cardnumber or login
    "password=s" => \$patron_password,      # patron's password

    "t|terminator=s" => \$terminator,

    'h|help|?' => \$help
);

if (   $help
    || !$host
    || !$login_user_id
    || !$login_password
    || !$location_code
    || !$patron_identifier
    || !$patron_password )
{
    print &help();
    exit();
}

$terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;

# Set perl to expect the same record terminator it is sending
$/ = $terminator;

my ( $sec, $min, $hour, $day, $month, $year ) = localtime(time);
$year += 1900;
my $transaction_date = "$year$month$day    $hour$min$sec";

my $institution_id    = $location_code;
my $terminal_password = $login_password;

my $socket = IO::Socket::INET->new("$host:$port")
  or die "ERROR in Socket Creation host=$host port=$port : $!\n";

my $login_command = "9300CN$login_user_id|CO$login_password|CP$location_code|";

print "\nOUTBOUND: $login_command\n";
print $socket $login_command . $terminator;

my $data = <$socket>;

print "\nINBOUND: $data\n";

if ( $data =~ '^941' ) { ## we are logged in

    ## Patron Status Request
    print "\nTrying 'Patron Status Request'\n";
    my $patron_status_request = "23001"
      . $transaction_date
      . "AO"  . $institution_id
      . "|AA" . $patron_identifier
      . "|AC" . $terminal_password
      . "|AD" . $patron_password;

    print "\nOUTBOUND: $patron_status_request\n";
    print $socket $patron_status_request . $terminator;

    $data = <$socket>;

    print "\nINBOUND: $data\n";

    ## Patron Information
    print "\nTrying 'Patron Information'\n";
    my $summary = "          ";
    $patron_status_request = "63001"
      . $transaction_date
      . $summary
      . "AO"  . $institution_id
      . "|AA" . $patron_identifier
      . "|AC" . $terminal_password
      . "|AD" . $patron_password;

    print "\nOUTBOUND: $patron_status_request\n";
    print $socket $patron_status_request . $terminator;

    $data = <$socket>;

    print "\nINBOUND: $data\n";

}
else {
    print "\nLogin Failed!\n";
}

sub help {
    print
q/sip_cli_emulator.pl - SIP command line emulator

Test a SIP2 service by sending patron status and patron
information requests.

Usage:
  sip_cli_emulator.pl [OPTIONS]

Options:
  --help           display help message

  -a --address     SIP server ip address or host name
  -p --port        SIP server port

  -su --sip_user   SIP server login username
  -sp --sip_pass   SIP server login password

  -l --location    SIP location code
 
  --patron         ILS patron cardnumber or username
  --password       ILS patron password

  -t --terminator  SIP2 message terminator, either CR, or CRLF
                   (defaults to CRLF)

/

}
- 

Return to bug 13159

Lines 1-161 Link Here

(-)a/misc/sip_cli_emulator.pl (-162 lines)
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	-

Line 0 Link Here

(-)a/C4/SIP/sip_cli_emulator.pl (+481 lines)
		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 => [
120	'patron_password',
121	],
122	},
123	patron_information => {
124	name => 'Patron Information',
125	subroutine => \&build_patron_information_command_message,
126	parameters => {
127	transaction_date => $transaction_date,
128	institution_id => $location_code,
129	patron_identifier => $patron_identifier,
130	terminal_password => $terminal_password,
131	patron_password => $patron_password,
132	},
133	optional => [
134	'patron_password',
135	],
136	},
137	checkout => {
138	name => 'Checkout',
139	subroutine => \&build_checkout_command_message,
140	parameters => {
141	SC_renewal_policy => 'Y',
142	no_block => 'N',
143	transaction_date => $transaction_date,
144	nb_due_date => undef,
145	institution_id => $location_code,
146	patron_identifier => $patron_identifier,
147	item_identifier => $item_identifier,
148	terminal_password => $terminal_password,
149	item_properties => undef,
150	patron_password => $patron_password,
151	fee_acknowledged => $fee_acknowledged,
152	cancel => undef,
153	},
154	optional => [
155	'nb_due_date', # defaults to transaction date
156	'item_properties',
157	'patron_password',
158	'fee_acknowledged',
159	'cancel',
160	],
161	},
162	checkin => {
163	name => 'Checkin',
164	subroutine => \&build_checkin_command_message,
165	parameters => {
166	no_block => 'N',
167	transaction_date => $transaction_date,
168	return_date => $transaction_date,
169	current_location => $location_code,
170	institution_id => $location_code,
171	item_identifier => $item_identifier,
172	terminal_password => $terminal_password,
173	item_properties => undef,
174	cancel => undef,
175	},
176	optional => [
177	'return_date', # defaults to transaction date
178	'item_properties',
179	'patron_password',
180	'cancel',
181	],
182	},
183	renew => {
184	name => 'Renew',
185	subroutine => \&build_renew_command_message,
186	parameters => {
187	third_party_allowed => 'N',
188	no_block => 'N',
189	transaction_date => $transaction_date,
190	nb_due_date => undef,
191	institution_id => $location_code,
192	patron_identifier => $patron_identifier,
193	patron_password => $patron_password,
194	item_identifier => $item_identifier,
195	title_identifier => undef,
196	terminal_password => $terminal_password,
197	item_properties => undef,
198	fee_acknowledged => $fee_acknowledged,
199	},
200	optional => [
201	'nb_due_date', # defaults to transaction date
202	'patron_password',
203	'item_identifier',
204	'title_identifier',
205	'terminal_password',
206	'item_properties',
207	'fee_acknowledged',
208	],
209	},
210	};
211
212	my $data = run_command_message('login');
213
214	if ( $data =~ '^941' ) { ## we are logged in
215	foreach my $m (@messages) {
216	say "Trying '$m'";
217
218	my $data = run_command_message($m);
219
220	}
221	}
222	else {
223	say "Login Failed!";
224	}
225
226	sub build_command_message {
227	my ($message) = @_;
228
229	##FIXME It would be much better to use exception handling so we aren't priting from subs
230	unless ( $handlers->{$message} ) {
231	say "$message is an unsupported command!";
232	return;
233	}
234
235	my $subroutine = $handlers->{$message}->{subroutine};
236	my $parameters = $handlers->{$message}->{parameters};
237	my %optional = map { $_ => 1 } @{ $handlers->{$message}->{optional} };
238
239	foreach my $key ( keys %$parameters ) {
240	unless ( $parameters->{$key} ) {
241	unless ( $optional{$key} ) {
242	say "$key is required for $message";
243	return;
244	}
245	}
246	}
247
248	return &$subroutine($parameters);
249	}
250
251	sub run_command_message {
252	my ($message) = @_;
253
254	my $command_message = build_command_message($message);
255
256	return unless $command_message;
257
258	say "SEND: $command_message";
259	print $socket $command_message . $terminator;
260
261	my $data = <$socket>;
262
263	say "READ: $data";
264
265	return $data;
266	}
267
268	sub build_login_command_message {
269	my ($params) = @_;
270
271	my $login_user_id = $params->{login_user_id};
272	my $login_password = $params->{login_password};
273	my $location_code = $params->{location_code};
274
275	return
276	LOGIN . "00"
277	. build_field( FID_LOGIN_UID, $login_user_id )
278	. build_field( FID_LOGIN_PWD, $login_password )
279	. build_field( FID_LOCATION_CODE, $location_code );
280	}
281
282	sub build_patron_status_request_command_message {
283	my ($params) = @_;
284
285	my $transaction_date = $params->{transaction_date};
286	my $institution_id = $params->{institution_id};
287	my $patron_identifier = $params->{patron_identifier};
288	my $terminal_password = $params->{terminal_password};
289	my $patron_password = $params->{patron_password};
290
291	return
292	PATRON_STATUS_REQ
293	. LANGUAGE
294	. $transaction_date
295	. build_field( FID_INST_ID, $institution_id )
296	. build_field( FID_PATRON_ID, $patron_identifier )
297	. build_field( FID_TERMINAL_PWD, $terminal_password )
298	. build_field( FID_PATRON_PWD, $patron_password );
299	}
300
301	sub build_patron_information_command_message {
302	my ($params) = @_;
303
304	my $transaction_date = $params->{transaction_date};
305	my $institution_id = $params->{institution_id};
306	my $patron_identifier = $params->{patron_identifier};
307	my $terminal_password = $params->{terminal_password};
308	my $patron_password = $params->{patron_password};
309
310	my $summary = " ";
311
312	return
313	PATRON_INFO
314	. LANGUAGE
315	. $transaction_date
316	. $summary
317	. build_field( FID_INST_ID, $institution_id )
318	. build_field( FID_PATRON_ID, $patron_identifier )
319	. build_field( FID_TERMINAL_PWD, $terminal_password )
320	. build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } );
321	}
322
323	sub build_checkout_command_message {
324	my ($params) = @_;
325
326	my $SC_renewal_policy = $params->{SC_renewal_policy};
327	my $no_block = $params->{no_block};
328	my $transaction_date = $params->{transaction_date};
329	my $nb_due_date = $params->{nb_due_date};
330	my $institution_id = $params->{institution_id};
331	my $patron_identifier = $params->{patron_identifier};
332	my $item_identifier = $params->{item_identifier};
333	my $terminal_password = $params->{terminal_password};
334	my $item_properties = $params->{item_properties};
335	my $patron_password = $params->{patron_password};
336	my $fee_acknowledged = $params->{fee_acknowledged};
337	my $cancel = $params->{cancel};
338
339	$SC_renewal_policy = $SC_renewal_policy ? 'Y' : 'N';
340	$no_block = $no_block ? 'Y' : 'N';
341	$fee_acknowledged = $fee_acknowledged ? 'Y' : 'N';
342	$cancel = $cancel ? 'Y' : 'N';
343
344	$nb_due_date \|\|= $transaction_date;
345
346	return
347	CHECKOUT
348	. $SC_renewal_policy
349	. $no_block
350	. $transaction_date
351	. $nb_due_date
352	. build_field( FID_INST_ID, $institution_id )
353	. build_field( FID_PATRON_ID, $patron_identifier )
354	. build_field( FID_ITEM_ID, $item_identifier )
355	. build_field( FID_TERMINAL_PWD, $terminal_password )
356	. build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
357	. build_field( FID_PATRON_PWD, $patron_password, { optional => 1 } )
358	. build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } )
359	. build_field( FID_CANCEL, $cancel, { optional => 1 } );
360	}
361
362	sub build_checkin_command_message {
363	my ($params) = @_;
364
365	my $no_block = $params->{no_block};
366	my $transaction_date = $params->{transaction_date};
367	my $return_date = $params->{return_date};
368	my $current_location = $params->{current_location};
369	my $institution_id = $params->{institution_id};
370	my $item_identifier = $params->{item_identifier};
371	my $terminal_password = $params->{terminal_password};
372	my $item_properties = $params->{item_properties};
373	my $cancel = $params->{cancel};
374
375	$no_block = $no_block ? 'Y' : 'N';
376	$cancel = $cancel ? 'Y' : 'N';
377
378	$return_date \|\|= $transaction_date;
379
380	return
381	CHECKIN
382	. $no_block
383	. $transaction_date
384	. $return_date
385	. build_field( FID_CURRENT_LOCN, $current_location )
386	. build_field( FID_INST_ID, $institution_id )
387	. build_field( FID_ITEM_ID, $item_identifier )
388	. build_field( FID_TERMINAL_PWD, $terminal_password )
389	. build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
390	. build_field( FID_CANCEL, $cancel, { optional => 1 } );
391	}
392
393	sub build_renew_command_message {
394	my ($params) = @_;
395
396	my $third_party_allowed = $params->{third_party_allowed};
397	my $no_block = $params->{no_block};
398	my $transaction_date = $params->{transaction_date};
399	my $nb_due_date = $params->{nb_due_date};
400	my $institution_id = $params->{institution_id};
401	my $patron_identifier = $params->{patron_identifier};
402	my $patron_password = $params->{patron_password};
403	my $item_identifier = $params->{item_identifier};
404	my $title_identifier = $params->{title_identifier};
405	my $terminal_password = $params->{terminal_password};
406	my $item_properties = $params->{item_properties};
407	my $fee_acknowledged = $params->{fee_acknowledged};
408
409	$third_party_allowed = $third_party_allowed ? 'Y' : 'N';
410	$no_block = $no_block ? 'Y' : 'N';
411	$fee_acknowledged = $fee_acknowledged ? 'Y' : 'N';
412
413	$nb_due_date \|\|= $transaction_date;
414
415	return
416	RENEW
417	. $third_party_allowed
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_PATRON_PWD, $patron_password, { optional => 1 } )
424	. build_field( FID_ITEM_ID, $item_identifier )
425	. build_field( FID_TITLE_ID, $title_identifier )
426	. build_field( FID_TERMINAL_PWD, $terminal_password )
427	. build_field( FID_ITEM_PROPS, $item_properties, { optional => 1 } )
428	. build_field( FID_FEE_ACK, $fee_acknowledged, { optional => 1 } );
429	}
430
431	sub build_field {
432	my ( $field_identifier, $value, $params ) = @_;
433
434	$params //= {};
435
436	return q{} if ( $params->{optional} && !$value );
437
438	return $field_identifier . $value . '\|';
439	}
440
441	sub help {
442	say q/sip_cli_emulator.pl - SIP command line emulator
443
444	Test a SIP2 service by sending patron status and patron
445	information requests.
446
447	Usage:
448	sip_cli_emulator.pl [OPTIONS]
449
450	Options:
451	--help display help message
452
453	-a --address SIP server ip address or host name
454	-p --port SIP server port
455
456	-su --sip_user SIP server login username
457	-sp --sip_pass SIP server login password
458
459	-l --location SIP location code
460
461	--patron ILS patron cardnumber or username
462	--password ILS patron password
463
464	--item ILS item identifier ( item barcode )
465
466	-t --terminator SIP2 message terminator, either CR, or CRLF
467	(defaults to CRLF)
468
469	-fa --fee-acknowledged Sends a confirmation of checkout fee
470
471	-m --message SIP2 message to execute
472
473	Implemented Messages:
474	patron_status_request
475	patron_information
476	checkout
477	checkin
478	renew
479
480	/
481	}