--- /dev/null
+#!/usr/bin/perl
+#
+# check if SIP terminal can Auth based on the xml config
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+
+BEGIN {
+ use_ok('Sip::Constants', qw(:all));
+ use_ok('SIPtest', qw(:basic :user1 :auth));
+ use_ok('C4::Auth', qw(&check_api_auth));
+ use_ok('C4::Context');
+ use_ok('CGI');
+ use_ok('Data::Dumper');
+}
+
+my ($status, $cookie, $sessionID, $uenv);
+my $query = CGI->new();
+ok($username, sprintf "\$username exported by SIPtest (%s)", ($username||''));
+ok($password, sprintf "\$password exported by SIPtest (%s)", ($password||''));
+
+ok($ENV{REMOTE_USER} = $username, "set ENV{REMOTE_USER}"); # from SIPtest
+ok($query->param(userid => $username), "set \$query->param('userid')");
+ok($query->param(password => $password), "set \$query->param('password')");
+
+$status = api_auth();
+$uenv = C4::Context->userenv;
+ok($status, sprintf "api_auth returned status (%s)", ($status ||''));
+ok($uenv, "After api_auth, Got C4::Context->userenv :" . ($uenv ? Dumper($uenv) : ''));
+
+($status, $cookie, $sessionID) = check_api_auth($query, {circulate=>1}, "intranet");
+
+ok($status, sprintf "checkauth returned status (%s)", ($status ||''));
+# ok($cookie, sprintf "checkauth returned cookie (%s)", ($cookie ||''));
+# ok($sessionID, sprintf "checkauth returned sessionID (%s)", ($sessionID||''));
+
+diag "note: checkauth " . ($cookie ? "returned cookie ($cookie)\n" : "did NOT return cookie\n" );
+diag "note: checkauth " . ($sessionID ? "returned sessionID ($sessionID)\n" : "did NOT return sessionID\n");
+
+$uenv = C4::Context->userenv;
+ok($uenv, "After checkauth, Got C4::Context->userenv :" . ($uenv ? Dumper($uenv) : ''));
+
+diag "Done.";
pat => qr/^940/,
fields => [], };
-my $invalid_pwd = { id => 'Invalid username',
+my $invalid_pwd = { id => 'Invalid password',
msg => "9300CN$username|COinvalid$password|CPThe floor|",
pat => qr/^940/,
fields => [], };
use warnings;
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $instid $currency $user_barcode $user_pin
- $user_fullname $user_homeaddr $user_email $user_phone
- $user_birthday);
+use SIPtest qw($datepat $instid $currency :user1);
my @tests = (
$SIPtest::login_test,
$SIPtest::sc_status_test,
{ id => 'valid Patron Status',
- msg => "2300120060101 084237AO$SIPtest::instid|AA$user_barcode|AD$user_pin|AC|",
+ msg => "2300120060101 084237AO$instid|AA$user_barcode|AD$user_pin|AC|",
pat => qr/^24 [ Y]{13}\d{3}$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat $instid $currency $user_barcode $user_pin
- $user_fullname $user_homeaddr $user_email $user_phone
- $user_birthday $user_ptype $user_inet);
+use SIPtest qw(:basic :user1);
# This is a template test case for the Patron Information
# message handling. Because of the large number of fields,
# situations: valid patron no details, valid patron with each
# individual detail requested, invalid patron, invalid patron
# password, etc.
-my $patron_info_test_template = {
+our $patron_info_test_template = {
id => 'valid Patron Info no details',
msg => "6300020060329 201700 AO$instid|AA$user_barcode|",
pat => qr/^64 [ Y]{13}\d{3}$datepat(\d{4}){6}/,
required => 1, },
], };
-my @tests = (
+our @tests = (
$SIPtest::login_test,
$SIPtest::sc_status_test,
clone($patron_info_test_template),
- );
+ );
# Create the test cases for the various summary detail fields
. $patron_info_summary_tests[$i]->{field};
push @{$test->{fields}}, $patron_info_summary_tests[$i];
push @tests, $test;
- }
+ }
}
sub create_invalid_patron_tests {
}
create_patron_summary_tests;
-
create_invalid_patron_tests;
-
SIPtest::run_sip_tests(@tests);
-
1;
use warnings;
use Clone qw(clone);
-use Sip::Constants qw(:all);
+use CGI;
-use SIPtest qw($datepat $textpat $instid $currency $user_barcode
- $item_barcode $item_title
- $item_diacritic_barcode $item_diacritic_title
- $item_diacritic_owner);
+use Sip::Constants qw(:all);
+use SIPtest qw(
+ :basic
+ $user_barcode $item_barcode $item_title
+ :diacritic
+ );
my $patron_enable_template = {
id => 'Renew All: prep: enable patron permissions',
my $patron_disable_template = {
id => 'Checkout: block patron (prep to test checkout denied)',
- msg => "01N20060102 084238AO$instid|ALHe's a jerk|AA$user_barcode|",
+ msg => "01N20060102 084238AO$instid|ALFees overrun|AA$user_barcode|",
# response to block patron is a patron status message
pat => qr/^24Y{4}[ Y]{10}000$datepat/o,
- fields => [], };
+ fields => [],
+};
my $checkin_template = {
- id => 'Checkout: cleanup: check in item',
- msg => "09N20050102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|",
- pat => qr/^101YNN$datepat/o,
- fields => [],
- };
+ id => 'Checkout: cleanup: check in item',
+ msg => "09N20050102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|",
+ pat => qr/^101YNN$datepat/o,
+ fields => [],
+};
my $checkout_test_template = {
id => 'Checkout: valid item, valid patron',
#$test = clone($checkout_test_template);
#$test->{id} = 'Checkout: patron renewal';
#$test->{pat} = qr/^121YNY$datepat/;
-#
+
#push @tests, $test;
# NOW check it in
push @tests, $checkin_template;
# Valid Patron, item with diacritical in the title
-$test = clone($checkout_test_template);
-
-$test->{id} = 'Checkout: valid patron, diacritical character in title';
-$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/;
+#$test = clone($checkout_test_template);
+#
+#$test->{id} = 'Checkout: valid patron, diacritical character in title';
+#$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/;
-foreach my $i (0 .. (scalar @{$test->{fields}})-1) {
- my $field = $test->{fields}[$i];
+#foreach my $i (0 .. (scalar @{$test->{fields}})-1) {
+# my $field = $test->{fields}[$i];
- if ($field->{field} eq FID_ITEM_ID) {
- $field->{pat} = qr/^$item_diacritic_barcode$/;
- } elsif ($field->{field} eq FID_TITLE_ID) {
- $field->{pat} = qr/^$item_diacritic_title\s*$/;
- } elsif ($field->{field} eq FID_OWNER) {
- $field->{pat} = qr/^$item_diacritic_owner$/;
- }
-}
+# if ($field->{field} eq FID_ITEM_ID) {
+# $field->{pat} = qr/^$item_diacritic_barcode$/;
+# } elsif ($field->{field} eq FID_TITLE_ID) {
+# $field->{pat} = qr/^$item_diacritic_title\s*$/;
+# } elsif ($field->{field} eq FID_OWNER) {
+# $field->{pat} = qr/^$item_diacritic_owner$/;
+# }
+#}
-push @tests, $test;
+#push @tests, $test;
-$test = clone($checkin_template);
-$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/;
-push @tests, $test;
+#$test = clone($checkin_template);
+#$test->{msg} =~ s/AB$item_barcode/AB$item_diacritic_barcode/;
+#push @tests, $test;
# Valid Patron, Invalid Item_id
$test = clone($checkout_test_template);
use Clone qw(clone);
use Sip::Constants qw(:all);
-
-use SIPtest qw($datepat $textpat);
+use SIPtest qw(:user1 :basic);
my $patron_status_test_template = {
id => 'Patron Status: valid patron, no patron password',
- msg => '2300120060101 084237AOUWOLS|AAdjfiander|ACterminal password|',
- pat => qr/^24 [ Y]{13}001$datepat/,
+ msg => "2300120060101 084237AO$instid|AA$user_barcode|AC$password|",
+ pat => qr/^24[ Y]{14}001$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^23529001000463$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^Edna Acosta$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
# Invalid patron
my $test = clone($patron_status_test_template);
-$test->{id} = 'Patron Status invalid id';
-$test->{msg} =~ s/AAdjfiander\|/AAberick|/;
+$test->{id} = 'Patron Status: invalid id';
+$test->{msg} =~ s/AA$user_barcode\|/AAbad_userid|/;
# The test assumes that the language sent by the terminal is
# just echoed back for invalid patrons.
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^berick$/,
+ pat => qr/^bad_userid$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
pat => qr/^$/,
$test = clone($patron_status_test_template);
$test->{id} = 'Patron Status: Valid patron, invalid patron password';
$test->{msg} .= (FID_PATRON_PWD) . 'badpwd|';
-$test->{pat} = qr/^24[ Y]{14}001$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^23529001000463$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^Edna Acosta$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat $instid $user_barcode $user_fullname);
+use SIPtest qw(:basic :user1);
my $block_patron_test_template = {
id => 'Block Patron: valid patron, card not retained',
- msg => "01N20060102 084238AO$instid|ALHe's a jerk|AA$user_barcode|ACterminal password|",
+ msg => "01N20060102 084238AO$instid|ALThis card is blocked.|AA$user_barcode|AC$password|",
# response to block patron is a patron status message
- pat => qr/^24Y[ Y]{13}000$datepat/o,
+ pat => qr/^24Y[ Y]{13}000$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat);
+use SIPtest qw(:basic :user1);
my $patron_enable_test_template = {
id => 'Patron Enable: valid patron',
- msg => "2520060102 084238AOUWOLS|AAdjfiander|",
+ msg => "2520060102 084238AOUWOLS|AA$user_barcode|",
pat => qr/^26 {4}[ Y]{10}000$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^$user_fullname$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
# ensure that he was properly enabled.
my $patron_disable_test_template = {
id => 'Patron Enable: block patron (prep to test enabling)',
- msg => "01N20060102 084238AOUWOLS|ALHe's a jerk|AAdjfiander|",
+ msg => "01N20060102 084238AO$instid|ALBlocked patron for SIP test.|AA$user_barcode|",
# response to block patron is a patron status message
pat => qr/^24Y{4}[ Y]{10}000$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^$user_fullname$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
# Valid patron, valid password
$test = clone($patron_enable_test_template);
$test->{id} = "Patron Enable: valid patron, valid password";
-$test->{msg} .= FID_PATRON_PWD . '6789|';
+$test->{msg} .= FID_PATRON_PWD . "$user_pin|";
$test->{pat} = qr/^26 {4}[ Y]{10}000$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^$user_fullname$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
- pat => qr/^David J\. Fiander$/,
+ pat => qr/^$user_fullname$/,
required => 1, },
{ field => FID_VALID_PATRON,
pat => qr/^Y$/,
# Invalid patron
$test = clone($patron_enable_test_template);
$test->{id} =~ s/valid/invalid/;
-$test->{msg} =~ s/AAdjfiander\|/AAberick|/;
+$test->{msg} =~ s/AA$user_barcode\|/AAbad_barcode|/;
$test->{pat} = qr/^26Y{4}[ Y]{10}000$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^berick$/,
+ pat => qr/^bad_barcode$/,
required => 1, },
{ field => FID_PERSONAL_NAME,
pat => qr/^$/,
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat);
+use SIPtest qw(:basic :user1 :user2 :item1 :item2);
my $hold_test_template = {
- id => 'Place Hold: valid item, valid patron',
- msg => '15+20060415 110158BW20060815 110158|BSTaylor|BY2|AOUWOLS|AAdjfiander|AB1565921879|',
- pat => qr/^161N$datepat/,
+ id => "Place Hold: valid item ($item_barcode), valid patron ($user_barcode)", #BS could be another branch
+ msg => "15+20060415 110158BW20060815 110158|BS$instid|BY2|AO$instid|AA$user_barcode|AB$item_barcode|",
+ pat => qr/^161Y$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_EXPIRATION,
pat => $datepat,
required => 0, },
{ field => FID_QUEUE_POS,
pat => qr/^1$/,
- required => 1, },
+ required => 0, },
{ field => FID_PICKUP_LOCN,
- pat => qr/^Taylor$/,
- required => 1, },
+ pat => qr/^$item_owner$/,
+ required => 0, },
{ field => FID_TITLE_ID,
- pat => qr/^Perl 5 desktop reference$/,
- required => 1, },
+ pat => qr/^$item_title$/,
+ required => 0, },
{ field => FID_ITEM_ID,
- pat => qr/^1565921879$/,
- required => 1, },
+ pat => qr/^$item_barcode$/,
+ required => 0, },
],};
+my $tmp_msg = "6300020060329 201700 AO$instid|AA$user_barcode|";
my $hold_count_test_template0 = {
- id => 'Confirm patron has 0 holds',
- msg => '6300020060329 201700 AOUWOLS|AAdjfiander|',
+ id => "Confirm patron ($user_barcode) has 0 holds",
+ msg => $tmp_msg,
pat => qr/^64 [ Y]{13}\d{3}${datepat}0000(\d{4}){5}/,
fields => [],
};
-
my $hold_count_test_template1 = {
- id => 'Confirm patron has 1 hold',
- msg => '6300020060329 201700 AOUWOLS|AAdjfiander|',
- pat => qr/^64 [ Y]{13}\d{3}${datepat}0001(\d{4}){5}/,
+ id => "Confirm patron ($user_barcode) has 1 hold",
+ msg => $tmp_msg,
+ pat => qr/^64 [ Y]{13}\d{3}${datepat}((0001(\d{4}){4}0000)|(0000(\d{4}){4}0001))/,
+ # The tricky part at the end here is because we don't know whether
+ # the hold will count as "waiting" or unavailable.
+ # But it will be one or the other!
fields => [],
};
-
my @tests = (
- $SIPtest::login_test,
- $SIPtest::sc_status_test,
- $hold_test_template, $hold_count_test_template1,
+ $SIPtest::login_test, # 1
+ $SIPtest::sc_status_test, # 2
+ $hold_test_template, $hold_count_test_template1, # 3,4
);
my $test;
# Hold Queue: second hold placed on item
$test = clone($hold_test_template);
-$test->{id} = 'Place hold: second hold on item';
-$test->{msg} =~ s/djfiander/miker/;
+$test->{id} = "Place 2nd hold on item ($item_barcode) for user ($user2_barcode)";
+$test->{msg} =~ s/AA$user_barcode\|/AA$user2_barcode|/;
$test->{pat} = qr/^161N$datepat/;
foreach my $i (0 .. (scalar @{$test->{fields}})-1) {
- my $field = $test->{fields}[$i];
-
- if ($field->{field} eq FID_PATRON_ID) {
- $field->{pat} = qr/^miker$/;
- } elsif ($field->{field} eq FID_QUEUE_POS) {
- $field->{pat} = qr/^2$/;
- }
+ my $field = $test->{fields}[$i];
+ if ($field->{field} eq FID_PATRON_ID) {
+ $field->{pat} = qr/^$user2_barcode$/;
+ } elsif ($field->{field} eq FID_QUEUE_POS) {
+ $field->{pat} = qr/^2$/;
+ }
}
-push @tests, $test;
+push @tests, $test; # 5
# Cancel hold: valid hold
$test = clone($hold_test_template);
-$test->{id} = 'Cancel hold: valid hold';
+$test->{id} = "Cancel Hold: valid hold for user ($user_barcode)";
$test->{msg} =~ s/\+/-/;
$test->{pat} = qr/^161[NY]$datepat/;
delete $test->{fields};
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
];
-push @tests, $test, $hold_count_test_template0;
+push @tests, $test, $hold_count_test_template0; # 6,7
# Cancel Hold: no hold on item
# $test is already set up to cancel a hold, just change
$test->{id} = 'Cancel Hold: no hold on specified item';
$test->{pat} = qr/^160N$datepat/;
-push @tests, $test, $hold_count_test_template0;
+push @tests, $test, $hold_count_test_template0; # 8,9
-# Cleanup: cancel miker's hold too.
+# Cleanup: cancel 2nd user's hold too.
$test = clone($hold_test_template);
-$test->{id} = "Cancel hold: cleanup second patron's hold";
+$test->{id} = "Cancel hold: cleanup hold for 2nd patron ($user2_barcode)";
$test->{msg} =~ s/\+/-/;
-$test->{msg} =~ s/djfiander/miker/;
+$test->{msg} =~ s/$user_barcode/$user2_barcode/;
$test->{pat} = qr/^161[NY]$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^miker$/,
+ pat => qr/^$user2_barcode$/,
required => 1, },
];
-push @tests, $test;
+push @tests, $test; # 11
# Place hold: valid patron, item, invalid patron pwd
$test = clone($hold_test_template);
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
];
-push @tests, $test, $hold_count_test_template0;
+push @tests, $test, $hold_count_test_template0; # 12,13
# Place hold: invalid patron
$test = clone($hold_test_template);
$test->{id} = 'Place hold: invalid patron';
-$test->{msg} =~ s/AAdjfiander\|/AAberick|/;
+$test->{msg} =~ s/AA$user_barcode\|/AAbad_barcode|/;
$test->{pat} = qr/^160N$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^berick$/,
+ pat => qr/^bad_barcode$/,
required => 1, },
];
# There's no patron to check the number of holds against
-push @tests, $test;
+push @tests, $test; # 14
# Place hold: invalid item
$test = clone($hold_test_template);
$test->{id} = 'Place hold: invalid item';
-$test->{msg} =~ s/AB1565921879\|/ABnosuchitem|/;
+$test->{msg} =~ s/AB$item_barcode\|/ABnosuchitem|/;
$test->{pat} = qr/^160N$datepat/;
delete $test->{fields};
$test->{fields} = [
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^djfiander$/,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_ITEM_ID,
pat => qr/^nosuchitem$/,
required => 0, },
];
-push @tests, $test, $hold_count_test_template0;
+push @tests, $test, $hold_count_test_template0; # 15
# Still need tests for:
# - valid patron not permitted to place holds
use Clone qw(clone);
use Sip::Constants qw(:all);
-
-use SIPtest qw($datepat $textpat $instid $user_barcode
- $item_barcode $item_title);
+use SIPtest qw(:basic :user1 :item1);
my $checkin_test_template = {
- id => 'Checkin: Item is checked out',
- msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|",
- pat => qr/^101YNN$datepat/o,
+ id => "Checkin: Item ($item_barcode) is checked out",
+ msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|AC$password|",
+ pat => qr/^101YNN$datepat/,
fields => [
$SIPtest::field_specs{(FID_INST_ID)},
$SIPtest::field_specs{(FID_SCREEN_MSG)},
$SIPtest::field_specs{(FID_PRINT_LINE)},
{ field => FID_PATRON_ID,
- pat => qr/^$user_barcode$/o,
+ pat => qr/^$user_barcode$/,
required => 1, },
{ field => FID_ITEM_ID,
- pat => qr/^$item_barcode$/o,
+ pat => qr/^$item_barcode$/,
required => 1, },
{ field => FID_PERM_LOCN,
pat => $textpat,
required => 1, },
{ field => FID_TITLE_ID,
- pat => qr/^$item_title\s*$/o,
+ pat => qr/^$item_title\s*$/,
required => 1, }, # not required by the spec.
],};
my $checkout_template = {
- id => 'Checkin: prep: check out item',
+ id => "Checkin: prep: check out item ($item_barcode)",
msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|",
- pat => qr/^121NNY$datepat/o,
+ pat => qr/^121NNY$datepat/,
fields => [],
};
my @tests = (
- $SIPtest::login_test,
- $SIPtest::sc_status_test,
- $checkout_template,
- $checkin_test_template,
- );
+ $SIPtest::login_test,
+ $SIPtest::sc_status_test,
+ $checkout_template,
+ $checkin_test_template,
+ );
my $test;
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat $instid $currency $user_barcode
- $item_barcode $item_title);
+use SIPtest qw(:basic :user1 :item1);
my $checkout_template = {
- id => 'Renew: prep: check out item',
- msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|",
- pat => qr/^121NNY$datepat/,
- fields => [],
- };
+ id => "Renew: prep: check out item ($item_barcode) to patron ($user_barcode)",
+ msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|",
+ pat => qr/^121NNY$datepat/,
+ fields => [],
+};
my $checkin_template = {
- id => 'Renew: prep: check in item',
- msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|",
- pat => qr/^101YNN$datepat/,
- fields => [],
- };
-
-#my $hold_template = {
-# id => 'Renew: prep: place hold on item',
-# msg =>"15+20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|",
-# pat => qr/^161N$datepat/,
-# fields => [],
-# };
+ id => "Renew: prep: check in item ($item_barcode)",
+ msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|AC$password|",
+ pat => qr/^101YNN$datepat/,
+ fields => [],
+};
+
+# my $hold_template = {
+# id => 'Renew: prep: place hold on item',
+# msg =>"15+20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|",
+# pat => qr/^161N$datepat/,
+# fields => [],
+# };
#
-#my $cancel_hold_template = {
-# id => 'Renew: cleanup: cancel hold on item',
-# msg =>"15-20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|",
-# pat => qr/^161[NY]$datepat/,
-# fields => [],
-# };
+# my $cancel_hold_template = {
+# id => 'Renew: cleanup: cancel hold on item',
+# msg =>"15-20060415 110158BW20060815 110158|BSTaylor|BY2|AO$instid|AAmiker|AB$item_barcode|",
+# pat => qr/^161[NY]$datepat/,
+# fields => [],
+# };
#
my $renew_test_template = {
- id => 'Renew: item id checked out to patron, renewal permitted, no 3rd party, no fees',
- msg => "29NN20060102 084236 AO$instid|AA$user_barcode|AB$item_barcode|",
- pat => qr/^301YNN$datepat/,
- fields => [
- $SIPtest::field_specs{(FID_INST_ID)},
- $SIPtest::field_specs{(FID_SCREEN_MSG)},
- $SIPtest::field_specs{(FID_PRINT_LINE)},
- { field => FID_PATRON_ID,
- pat => qr/^$user_barcode$/,
- required => 1, },
- { field => FID_ITEM_ID,
- pat => qr/^$item_barcode$/,
- required => 1, },
- { field => FID_TITLE_ID,
- pat => qr/^$item_title\s*$/,
- required => 1, },
- { field => FID_DUE_DATE,
- pat => qr/^$datepat$/,
- required => 1, },
- { field => FID_SECURITY_INHIBIT,
- pat => qr/^[YN]$/,
- required => 0, },
- ],};
+ id => "Renew: item ($item_barcode) to patron ($user_barcode), renewal OK, no 3rd party, no fees",
+ msg => "29NN20060102 084236 AO$instid|AA$user_barcode|AB$item_barcode|",
+ pat => qr/^301YNN$datepat/,
+ fields => [
+ $SIPtest::field_specs{(FID_INST_ID)},
+ $SIPtest::field_specs{(FID_SCREEN_MSG)},
+ $SIPtest::field_specs{(FID_PRINT_LINE)},
+ { field => FID_PATRON_ID,
+ pat => qr/^$user_barcode$/,
+ required => 1, },
+ { field => FID_ITEM_ID,
+ pat => qr/^$item_barcode$/,
+ required => 1, },
+ { field => FID_TITLE_ID,
+ pat => qr/^$item_title\s*$/,
+ required => 1, },
+ { field => FID_DUE_DATE,
+ pat => qr/^$datepat$/,
+ required => 1, },
+ { field => FID_SECURITY_INHIBIT,
+ pat => qr/^[YN]$/,
+ required => 0, },
+ ],
+};
my @tests = (
- $SIPtest::login_test,
- $SIPtest::sc_status_test,
- $checkout_template,
- $renew_test_template,
- );
+ $SIPtest::login_test,
+ $SIPtest::sc_status_test,
+ $checkout_template,
+ $renew_test_template,
+);
my $test;
#
# Renew: item not checked out. Basically the same, except
# for the leader test.
+
$test = clone($renew_test_template);
$test->{id} = 'Renew: item not checked out at all';
$test->{pat} = qr/^300NUN$datepat/;
foreach my $field (@{$test->{fields}}) {
- if ($field->{field} eq FID_DUE_DATE) {
- $field->{pat} = qr/^$/;
- } elsif ($field->{field} eq FID_TITLE_ID) {
- $field->{pat} = qr/^($item_title\s*|)$/;
- }
+ if ($field->{field} eq FID_DUE_DATE) {
+ $field->{pat} = qr/^$/;
+ } elsif ($field->{field} eq FID_TITLE_ID) {
+ $field->{pat} = qr/^($item_title\s*|)$/;
+ }
}
push @tests, $checkin_template, $test;
$test = clone($renew_test_template);
-$test->{id} = 'Renew: Invalid item';
+$test->{id} = 'Renew: Invalid item (bad-item)';
$test->{msg} =~ s/AB[^|]+/ABbad-item/;
$test->{pat} = qr/^300NUN$datepat/;
foreach my $field (@{$test->{fields}}) {
- if ($field->{field} eq FID_TITLE_ID || $field->{field} eq FID_DUE_DATE) {
- $field->{pat} = qr/^$/;
- } elsif ($field->{field} eq FID_ITEM_ID) {
- $field->{pat} = qr/^bad-item$/;
- }
+ if ($field->{field} eq FID_TITLE_ID || $field->{field} eq FID_DUE_DATE) {
+ $field->{pat} = qr/^$/;
+ } elsif ($field->{field} eq FID_ITEM_ID) {
+ $field->{pat} = qr/^bad-item$/;
+ }
}
push @tests, $test;
$test = clone($renew_test_template);
-$test->{id} = 'Renew: Invalid user';
-$test->{msg} =~ s/AA$user_barcode/AAberick/;
+$test->{id} = 'Renew: Invalid user (bad_barcode)';
+$test->{msg} =~ s/AA$user_barcode/AAbad_barcode/;
$test->{pat} = qr/^300NUN$datepat/;
foreach my $field (@{$test->{fields}}) {
- if ($field->{field} eq FID_DUE_DATE) {
- $field->{pat} = qr/^$/;
- } elsif ($field->{field} eq FID_PATRON_ID) {
- $field->{pat} = qr/^berick$/;
- } elsif ($field->{field} eq FID_TITLE_ID) {
- $field->{pat} = qr/^($item_title\s*|)$/;
- }
+ if ($field->{field} eq FID_DUE_DATE) {
+ $field->{pat} = qr/^$/;
+ } elsif ($field->{field} eq FID_PATRON_ID) {
+ $field->{pat} = qr/^bad_barcode$/;
+ } elsif ($field->{field} eq FID_TITLE_ID) {
+ $field->{pat} = qr/^($item_title\s*|)$/;
+ }
}
push @tests, $test;
use Sip::Constants qw(:all);
-use SIPtest qw($datepat $textpat $user_barcode $item_barcode $item_owner
- $item2_barcode $item2_owner $instid);
+use SIPtest qw(:basic :user1 :item1 :item2);
my $enable_template = {
id => 'Renew All: prep: enable patron permissions',
};
my @checkout_templates = (
- { id => "Renew All: prep: check out $item_barcode",
- msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC|",
- pat => qr/^121NNY$datepat/,
- fields => [],},
- { id => "Renew All: prep: check out $item2_barcode",
- msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item2_barcode|AC|",
- pat => qr/^121NNY$datepat/,
- fields => [],}
- );
+ { id => "Renew All: prep: check out $item_barcode to $user_barcode",
+ msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item_barcode|AC$password|",
+ pat => qr/^121NNY$datepat/,
+ fields => [],},
+ { id => "Renew All: prep: check out $item2_barcode to $user_barcode",
+ msg => "11YN20060329 203000 AO$instid|AA$user_barcode|AB$item2_barcode|AC$password|",
+ pat => qr/^121NNY$datepat/,
+ fields => [],}
+);
my @checkin_templates = (
- { id => "Renew All: prep: check in $item_barcode",
- msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|ACterminal password|",
- pat => qr/^101YNN$datepat/,
- fields => [],},
- { id => "Renew All: prep: check in $item2_barcode",
- msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item2_barcode|ACterminal password|",
- pat => qr/^101YNN$datepat/,
- fields => [],}
- );
+ { id => "Renew All: prep: check in $item_barcode",
+ msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item_barcode|AC$password|",
+ pat => qr/^101YNN$datepat/,
+ fields => [],},
+ { id => "Renew All: prep: check in $item2_barcode",
+ msg => "09N20060102 08423620060113 084235APUnder the bed|AO$instid|AB$item2_barcode|AC$password|",
+ pat => qr/^101YNN$datepat/,
+ fields => [],}
+);
my $renew_all_test_template = {
- id => 'Renew All: valid patron with one item checked out, no patron password',
- msg => "6520060102 084236AO$instid|AA$user_barcode|",
- pat => qr/^66100010000$datepat/,
- fields => [
- $SIPtest::field_specs{(FID_INST_ID)},
- $SIPtest::field_specs{(FID_SCREEN_MSG)},
- $SIPtest::field_specs{(FID_PRINT_LINE)},
- { field => FID_RENEWED_ITEMS,
- pat => qr/^$item_barcode$/,
- required => 1, },
- ],};
+ id => "Renew All: patron ($user_barcode) with 1 item checked out, no patron password",
+ msg => "6520060102 084236AO$instid|AA$user_barcode|",
+ pat => qr/^66100010000$datepat/,
+ fields => [
+ $SIPtest::field_specs{(FID_INST_ID)},
+ $SIPtest::field_specs{(FID_SCREEN_MSG)},
+ $SIPtest::field_specs{(FID_PRINT_LINE)},
+ { field => FID_RENEWED_ITEMS,
+ pat => qr/^$item_barcode$/,
+ required => 1, },
+ ]
+};
my @tests = (
$SIPtest::login_test,
$test = clone($renew_all_test_template);
$test->{id} = 'Renew All: valid patron, invalid patron password';
-$test->{msg} .= (FID_PATRON_PWD) . 'badpwd|';
+$test->{msg} .= (FID_PATRON_PWD) . 'bad_pwd|';
$test->{pat} = qr/^66000000000$datepat/;
delete $test->{fields};
$test->{fields} = [
$test = clone($renew_all_test_template);
$test->{id} = 'Renew All: invalid patron';
-$test->{msg} =~ s/AA$user_barcode/AAberick/;
+$test->{msg} =~ s/AA$user_barcode/AAbad_barcode/;
$test->{pat} = qr/^66000000000$datepat/;
delete $test->{fields};
$test->{fields} = [
#!/usr/bin/perl
-# renew_all: test Renew All Response
+# Item Information test
use strict;
use warnings;
use Clone qw(clone);
use Sip::Constants qw(:all);
-
-use SIPtest qw($datepat $textpat $instid $currency $user_barcode
- $item_barcode $item_title $item_owner);
+use SIPtest qw(:basic :user1 :item1);
my $item_info_test_template = {
- id => 'Item Information: check information for available item',
- msg => "1720060110 215612AO$instid|AB$item_barcode|",
- pat => qr/^180[13]0201$datepat/, # status of 'other' or 'available'
- fields => [
- $SIPtest::field_specs{(FID_SCREEN_MSG)},
- $SIPtest::field_specs{(FID_PRINT_LINE)},
- { field => FID_ITEM_ID,
- pat => qr/^$item_barcode$/,
- required => 1, },
- { field => FID_TITLE_ID,
- pat => qr/^$item_title\s*$/,
- required => 1, },
- { field => FID_MEDIA_TYPE,
- pat => qr/^\d{3}$/,
- required => 0, },
- { field => FID_OWNER,
- pat => qr/^$item_owner$/,
- required => 0, },
- ], };
+ id => "Item Information: check info for available item ($item_barcode)",
+ msg => "1720060110 215612AO$instid|AB$item_barcode|",
+ pat => qr/^180[13]0201$datepat/, # status of 'other' or 'available'
+ fields => [
+ $SIPtest::field_specs{(FID_SCREEN_MSG)},
+ $SIPtest::field_specs{(FID_PRINT_LINE)},
+ { field => FID_ITEM_ID,
+ pat => qr/^$item_barcode$/,
+ required => 1, },
+ { field => FID_TITLE_ID,
+ pat => qr/^$item_title\s*$/,
+ required => 1, },
+ { field => FID_MEDIA_TYPE,
+ pat => qr/^\d{3}$/,
+ required => 0, },
+ { field => FID_OWNER,
+ pat => qr/^$item_owner$/,
+ required => 0, },
+ ],
+};
my @tests = (
- $SIPtest::login_test,
- $SIPtest::sc_status_test,
- clone($item_info_test_template),
- );
+ $SIPtest::login_test,
+ $SIPtest::sc_status_test,
+ $item_info_test_template,
+);
SIPtest::run_sip_tests(@tests);
#
#
-TESTS = 00sc_status.t 01patron_status.t 02patron_info.t 03checkout.t \
+TESTS = 000_sc_config_auth.t \
+ 00sc_status.t 01patron_status.t 02patron_info.t 03checkout.t \
04patron_status.t 05block_patron.t 06patron_enable.t 07hold.t \
08checkin.t 09renew.t 10renew_all.t 11item_info.t
prove -I.. $(OILS_TESTS)
test:
- prove -I.. $(TESTS)
+ prove -I../ -I./ $(TESTS)
use warnings;
use Exporter;
-
-our @ISA = qw(Exporter);
-
-our @EXPORT_OK = qw(run_sip_tests no_tagged_fields
- $datepat $textpat
- $login_test $sc_status_test
- %field_specs
-
- $instid $currency $server $username $password
- $user_barcode $user_pin $user_fullname $user_homeaddr
- $user_email $user_phone $user_birthday $user_ptype
- $user_inet
- $item_barcode $item_title $item_owner
- $item2_barcode $item2_title $item2_owner
- $item_diacritic_barcode $item_diacritic_title
- $item_diacritic_owner);
-#use Data::Dumper;
+use vars qw(@ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+use Data::Dumper;
+
+BEGIN {
+ @ISA = qw(Exporter);
+ %EXPORT_TAGS = (
+ auth => [qw(&api_auth)],
+ basic => [qw($datepat $textpat $login_test $sc_status_test
+ $instid $currency $server $username $password)],
+ user1 => [qw($user_barcode $user_pin $user_fullname $user_homeaddr $user_email
+ $user_phone $user_birthday $user_ptype $user_inet)],
+ item1 => [qw($item_barcode $item_title $item_owner )],
+ diacritic => [qw($item_diacritic_barcode $item_diacritic_title $item_diacritic_owner)],
+ );
+ # duplicate user1 and item1 as user2 and item2
+ # w/ tags like $user2_pin instead of $user_pin
+ foreach my $tag (qw(user item)) {
+ my @tags = @{$EXPORT_TAGS{$tag.'1'}}; # fresh array avoids side affect in map
+ push @{$EXPORT_TAGS{$tag.'2'}}, map {s/($tag)\_/${1}2_/;$_} @tags;
+ }
+ # From perldoc Exporter
+ # Add all the other ":class" tags to the ":all" class, deleting duplicates
+ my %seen;
+ push @{$EXPORT_TAGS{all}},
+ grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
+ Exporter::export_ok_tags('all'); # Anything in a tag is in OK_EXPORT
+ # print Dumper(\%EXPORT_TAGS); # Uncomment if you want to see the results of these tricks.
+}
# The number of tests is set in run_sip_tests() below, based
# on the size of the array of tests.
use Test::More;
+use CGI;
use IO::Socket::INET;
use Sip qw(:all);
use Sip::Checksum qw(verify_cksum);
use Sip::Constants qw(:all);
+use C4::Auth qw(&check_api_auth);
+use C4::Context;
+
#
# Configuration parameters to run the test suite
#
-our $instid = 'kohalibrary';
-our $currency = 'USD';
-#our $instid = 'UWOLS';
-#our $currency = 'CAD';
-our $server = 'localhost:6001'; # Address of the SIP server
+our $instid = 'CPL'; # 'UWOLS';
+our $currency = 'USD'; # 'CAD';
+our $server = 'localhost:6001'; # Address of the SIP server
# SIP username and password to connect to the server. See the
# SIP config.xml for the correct values.
-our $username = 'koha';
-our $password = 'koha';
+our $username = 'term1';
+our $password = 'term1';
# ILS Information
+# NOTE: make sure to escape the data for use in RegExp.
# Valid user barcode and corresponding user password/pin and full name
-our $user_barcode = 'djfiander';
-our $user_pin = '6789';
-our $user_fullname= 'David J\. Fiander';
-our $user_homeaddr= '2 Meadowvale Dr\. St Thomas, ON';
-our $user_email = 'djfiander\@hotmail\.com';
-our $user_phone = '\(519\) 555 1234';
-our $user_birthday= '19640925';
-our $user_ptype = 'A';
+our $user_barcode = '23529001000463';
+our $user_pin = 'fn5zS';
+our $user_fullname= 'Edna Acosta';
+our $user_homeaddr= '7896 Library Rd\.';
+our $user_email = 'patron\@liblime\.com';
+our $user_phone = '\(212\) 555-1212';
+our $user_birthday= '1980-04-24';
+our $user_ptype = 'PT';
our $user_inet = 'Y';
+# Another valid user
+our $user2_barcode = '23529000240482';
+our $user2_pin = 'jw937';
+our $user2_fullname= 'Jamie White';
+our $user2_homeaddr= '937 Library Rd\.';
+our $user2_email = 'patron\@liblime\.com';
+our $user2_phone = '\(212\) 555-1212';
+our $user2_birthday= '1950-04-22';
+our $user2_ptype = 'T';
+our $user2_inet = 'Y';
+
# Valid item barcode and corresponding title
-our $item_barcode = '1565921879';
-our $item_title = 'Perl 5 desktop reference';
-our $item_owner = 'kohalibrary';
+our $item_barcode = '502326000005';
+our $item_title = 'How I became a pirate /';
+our $item_owner = 'CPL';
# Another valid item
-our $item2_barcode = '0440242746';
-our $item2_title = 'The deep blue alibi';
-our $item2_owner = 'kohalibrary';
+our $item2_barcode = '502326000011';
+our $item2_title = 'The biggest, smallest, fastest, tallest things you\'ve ever heard of /';
+our $item2_owner = 'CPL';
# An item with a diacritical in the title
-our $item_diacritic_barcode = '660';
-our $item_diacritic_title = 'Harry Potter y el cáliz de fuego';
-our $item_diacritic_owner = 'kohalibrary';
+our $item_diacritic_barcode = '502326001030';
+our $item_diacritic_titlea = 'Hari Poṭer u-geviʻa ha-esh /';
+our $item_diacritic_owner = 'CPL';
# End configuration
our $textpat = qr/^[^|]*$/;
our %field_specs = (
- (FID_SCREEN_MSG) => { field => FID_SCREEN_MSG,
- pat => $textpat,
- required => 0, },
- (FID_PRINT_LINE) => { field => FID_PRINT_LINE,
- pat => $textpat,
- required => 0, },
- (FID_INST_ID) => { field => FID_INST_ID,
- pat => qr/^$instid$/o,
- required => 1, },
- (FID_HOLD_ITEMS_LMT)=> { field => FID_HOLD_ITEMS_LMT,
- pat => qr/^\d{4}$/,
- required => 0, },
- (FID_OVERDUE_ITEMS_LMT)=> { field => FID_OVERDUE_ITEMS_LMT,
- pat => qr/^\d{4}$/,
- required => 0, },
- (FID_CHARGED_ITEMS_LMT)=> { field => FID_CHARGED_ITEMS_LMT,
- pat => qr/^\d{4}$/,
- required => 0, },
- (FID_VALID_PATRON) => { field => FID_VALID_PATRON,
- pat => qr/^[NY]$/,
- required => 0, },
- (FID_VALID_PATRON_PWD)=> { field => FID_VALID_PATRON_PWD,
- pat => qr/^[NY]$/,
- required => 0, },
- (FID_CURRENCY) => { field => FID_CURRENCY,
- pat => qr/^$currency$/io,
- required => 0, },
- );
+ (FID_SCREEN_MSG) => { field => FID_SCREEN_MSG,
+ pat => $textpat,
+ required => 0, },
+ (FID_PRINT_LINE) => { field => FID_PRINT_LINE,
+ pat => $textpat,
+ required => 0, },
+ (FID_INST_ID) => { field => FID_INST_ID,
+ pat => qr/^$instid$/o,
+ required => 1, },
+ (FID_HOLD_ITEMS_LMT)=> { field => FID_HOLD_ITEMS_LMT,
+ pat => qr/^\d{4}$/,
+ required => 0, },
+ (FID_OVERDUE_ITEMS_LMT)=> { field => FID_OVERDUE_ITEMS_LMT,
+ pat => qr/^\d{4}$/,
+ required => 0, },
+ (FID_CHARGED_ITEMS_LMT)=> { field => FID_CHARGED_ITEMS_LMT,
+ pat => qr/^\d{4}$/,
+ required => 0, },
+ (FID_VALID_PATRON) => { field => FID_VALID_PATRON,
+ pat => qr/^[NY]$/,
+ required => 0, },
+ (FID_VALID_PATRON_PWD)=> { field => FID_VALID_PATRON_PWD,
+ pat => qr/^[NY]$/,
+ required => 0, },
+ (FID_CURRENCY) => { field => FID_CURRENCY,
+ pat => qr/^$currency$/io,
+ required => 0, },
+ );
# Login and SC Status are always the first two messages that
# the terminal sends to the server, so just create the test
# If reading or writing fails, then the server's dead,
# so there's no point in continuing.
if (!write_msg({seqno => $seqno}, $test->{msg}, $sock)) {
- BAIL_OUT("Write failure in $test->{id}");
+ BAIL_OUT("Write failure in $test->{id}");
} elsif (!($resp = <$sock>)) {
- BAIL_OUT("Read failure in $test->{id}");
+ BAIL_OUT("Read failure in $test->{id}");
}
- chomp($resp);
+ chomp($resp);
+ $resp =~ tr/\cM//d;
+ chomp($resp);
- if (!verify_cksum($resp)) {
- fail("checksum $test->{id}");
- return;
- }
- if ($resp !~ $test->{pat}) {
- fail("match leader $test->{id}");
- diag("Response '$resp' doesn't match pattern '$test->{pat}'");
- return;
- }
+ if (!verify_cksum($resp)) {
+ fail("$test->{id} checksum($resp)");
+ return;
+ }
+ if ($resp !~ $test->{pat}) {
+ fail("match leader $test->{id}");
+ diag("Response '$resp' doesn't match pattern '$test->{pat}'");
+ return;
+ }
- # Split the tagged fields of the response into (name, value)
- # pairs and stuff them into the hash.
- $resp =~ $test->{pat};
- %fields = substr($resp, $+[0]) =~ /(..)([^|]*)\|/go;
+ # Split the tagged fields of the response into (name, value)
+ # pairs and stuff them into the hash.
+ $resp =~ $test->{pat};
+ %fields = substr($resp, $+[0]) =~ /(..)([^|]*)\|/go;
-# print STDERR Dumper($test);
-# print STDERR Dumper(\%fields);
- if (!defined($test->{fields})) {
- diag("TODO: $test->{id} field tests not written yet");
- } else {
+ # print STDERR "one_msg ( test ) : " . Dumper($test) . "\n" .
+ # "one_msg (fields) : " . Dumper(\%fields);
+ if (!defined($test->{fields})) {
+ diag("TODO: $test->{id} field tests not written yet");
+ } else {
# If there are no tagged fields, then 'fields' should be an
# empty list which will automatically skip this loop
foreach my $ftest (@{$test->{fields}}) {
my $field = $ftest->{field};
if ($ftest->{required} && !exists($fields{$field})) {
- fail("$test->{id} required field '$field' exists in '$resp'");
+ fail("$test->{id}: required field '$field' not found in '$resp'");
return;
}
if (exists($fields{$field}) && ($fields{$field} !~ $ftest->{pat})) {
-
fail("$test->{id} field test $field");
- diag("Field pattern '$ftest->{pat}' for '$field' doesn't match in '$resp'");
+ diag("Field '$field' pattern '$ftest->{pat}' fails to match value '$fields{$field}' in message '$resp'");
return;
}
}
return;
}
-#
-# _count_tests: Count the number of tests in a test array
-sub _count_tests {
- return scalar @_;
+sub api_auth() {
+ # AUTH
+ $ENV{REMOTE_USER} = $username;
+ my $query = CGI->new();
+ $query->param(userid => $username);
+ $query->param(password => $password);
+ my ($status, $cookie, $sessionID) = check_api_auth($query, {circulate=>1}, "intranet");
+ print STDERR "check_api_auth returns " . ($status || 'undef') . "\n";
+ # print STDERR "api_auth userenv = " . &dump_userenv;
+ return $status;
+}
+
+sub dump_userenv {
+ my $userenv = C4::Context->userenv;
+ return "# userenv: EMPTY\n" unless ($userenv);
+ my $userbranch = $userenv->{branch};
+ return "# userenv: " . Dumper($userenv)
+ . ($userbranch ? "BRANCH FOUND: $userbranch\n" : "NO BRANCH FOUND\n");
}
sub run_sip_tests {
BAIL_OUT('failed to create connection to server') unless $sock;
$seqno = 1;
-
- plan tests => _count_tests(@_);
-
+ # print STDERR "Number of tests : ", scalar (@_), "\n";
+ plan tests => scalar(@_);
foreach my $test (@_) {
- one_msg($sock, $test, $seqno++);
- $seqno %= 10; # sequence number is one digit
+ # print STDERR "Test $seqno:" . Dumper($test);
+ one_msg($sock, $test, $seqno++);
+ $seqno %= 10; # sequence number is one digit
}
}
projects / koha.git / commitdiff