8 our @ISA = qw(Exporter);
10 our @EXPORT_OK = qw(run_sip_tests no_tagged_fields
12 $login_test $sc_status_test
15 $instid $currency $server $username $password
16 $user_barcode $user_pin $user_fullname $user_homeaddr
17 $user_email $user_phone $user_birthday $user_ptype
19 $item_barcode $item_title $item_owner
20 $item2_barcode $item2_title $item2_owner
21 $item_diacritic_barcode $item_diacritic_title
22 $item_diacritic_owner);
25 # The number of tests is set in run_sip_tests() below, based
26 # on the size of the array of tests.
31 use Sip::Checksum qw(verify_cksum);
32 use Sip::Constants qw(:all);
35 # Configuration parameters to run the test suite
37 our $instid = 'kohalibrary';
38 our $currency = 'USD';
39 #our $instid = 'UWOLS';
40 #our $currency = 'CAD';
41 our $server = 'localhost:6001'; # Address of the SIP server
43 # SIP username and password to connect to the server. See the
44 # SIP config.xml for the correct values.
45 our $username = 'koha';
46 our $password = 'koha';
50 # Valid user barcode and corresponding user password/pin and full name
51 our $user_barcode = 'djfiander';
52 our $user_pin = '6789';
53 our $user_fullname= 'David J\. Fiander';
54 our $user_homeaddr= '2 Meadowvale Dr\. St Thomas, ON';
55 our $user_email = 'djfiander\@hotmail\.com';
56 our $user_phone = '\(519\) 555 1234';
57 our $user_birthday= '19640925';
58 our $user_ptype = 'A';
61 # Valid item barcode and corresponding title
62 our $item_barcode = '1565921879';
63 our $item_title = 'Perl 5 desktop reference';
64 our $item_owner = 'kohalibrary';
67 our $item2_barcode = '0440242746';
68 our $item2_title = 'The deep blue alibi';
69 our $item2_owner = 'kohalibrary';
71 # An item with a diacritical in the title
72 our $item_diacritic_barcode = '660';
73 our $item_diacritic_title = 'Harry Potter y el cáliz de fuego';
74 our $item_diacritic_owner = 'kohalibrary';
78 # Pattern for a SIP datestamp, to be used by individual tests to
79 # match timestamp fields (duh).
80 our $datepat = '\d{8} {4}\d{6}';
82 # Pattern for a random text field (may be empty)
83 our $textpat = qr/^[^|]*$/;
86 (FID_SCREEN_MSG) => { field => FID_SCREEN_MSG,
89 (FID_PRINT_LINE) => { field => FID_PRINT_LINE,
92 (FID_INST_ID) => { field => FID_INST_ID,
93 pat => qr/^$instid$/o,
95 (FID_HOLD_ITEMS_LMT)=> { field => FID_HOLD_ITEMS_LMT,
98 (FID_OVERDUE_ITEMS_LMT)=> { field => FID_OVERDUE_ITEMS_LMT,
101 (FID_CHARGED_ITEMS_LMT)=> { field => FID_CHARGED_ITEMS_LMT,
104 (FID_VALID_PATRON) => { field => FID_VALID_PATRON,
107 (FID_VALID_PATRON_PWD)=> { field => FID_VALID_PATRON_PWD,
110 (FID_CURRENCY) => { field => FID_CURRENCY,
111 pat => qr/^$currency$/io,
115 # Login and SC Status are always the first two messages that
116 # the terminal sends to the server, so just create the test
117 # cases here and reference them in the individual test files.
119 our $login_test = { id => 'login',
120 msg => "9300CN$username|CO$password|CPThe floor|",
124 our $sc_status_test = { id => 'SC status',
126 pat => qr/^98[YN]{6}\d{3}\d{3}$datepat(2\.00|1\.00)/,
128 $field_specs{(FID_SCREEN_MSG)},
129 $field_specs{(FID_PRINT_LINE)},
130 $field_specs{(FID_INST_ID)},
135 pat => qr/^[YN]{16}$/,
144 my ($sock, $test, $seqno) = @_;
148 # If reading or writing fails, then the server's dead,
149 # so there's no point in continuing.
150 if (!write_msg({seqno => $seqno}, $test->{msg}, $sock)) {
151 BAIL_OUT("Write failure in $test->{id}");
152 } elsif (!($resp = <$sock>)) {
153 BAIL_OUT("Read failure in $test->{id}");
158 if (!verify_cksum($resp)) {
159 fail("checksum $test->{id}");
162 if ($resp !~ $test->{pat}) {
163 fail("match leader $test->{id}");
164 diag("Response '$resp' doesn't match pattern '$test->{pat}'");
168 # Split the tagged fields of the response into (name, value)
169 # pairs and stuff them into the hash.
170 $resp =~ $test->{pat};
171 %fields = substr($resp, $+[0]) =~ /(..)([^|]*)\|/go;
173 # print STDERR Dumper($test);
174 # print STDERR Dumper(\%fields);
175 if (!defined($test->{fields})) {
176 diag("TODO: $test->{id} field tests not written yet");
178 # If there are no tagged fields, then 'fields' should be an
179 # empty list which will automatically skip this loop
180 foreach my $ftest (@{$test->{fields}}) {
181 my $field = $ftest->{field};
183 if ($ftest->{required} && !exists($fields{$field})) {
184 fail("$test->{id} required field '$field' exists in '$resp'");
188 if (exists($fields{$field}) && ($fields{$field} !~ $ftest->{pat})) {
190 fail("$test->{id} field test $field");
191 diag("Field pattern '$ftest->{pat}' for '$field' doesn't match in '$resp'");
201 # _count_tests: Count the number of tests in a test array
209 $Sip::error_detection = 1;
212 $sock = new IO::Socket::INET(PeerAddr => $server,
213 Type => SOCK_STREAM);
215 BAIL_OUT('failed to create connection to server') unless $sock;
219 plan tests => _count_tests(@_);
221 foreach my $test (@_) {
222 one_msg($sock, $test, $seqno++);
223 $seqno %= 10; # sequence number is one digit