Lines 21-27
Link Here
|
21 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
21 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
22 |
|
22 |
|
23 |
use Modern::Perl; |
23 |
use Modern::Perl; |
24 |
use Test::More tests => 3; |
24 |
use Test::More tests => 4; |
25 |
use Test::MockObject; |
25 |
use Test::MockObject; |
26 |
use Test::MockModule; |
26 |
use Test::MockModule; |
27 |
use Test::Warn; |
27 |
use Test::Warn; |
Lines 36-41
use Koha::Items;
Link Here
|
36 |
use Koha::Checkouts; |
36 |
use Koha::Checkouts; |
37 |
use Koha::Old::Checkouts; |
37 |
use Koha::Old::Checkouts; |
38 |
use Koha::Patrons; |
38 |
use Koha::Patrons; |
|
|
39 |
use Koha::Patron::Attribute; |
40 |
use Koha::Patron::Attributes; |
39 |
|
41 |
|
40 |
use C4::SIP::ILS; |
42 |
use C4::SIP::ILS; |
41 |
use C4::SIP::ILS::Patron; |
43 |
use C4::SIP::ILS::Patron; |
Lines 64-69
subtest 'Testing Patron Info Request V2' => sub {
Link Here
|
64 |
$schema->storage->txn_rollback; |
66 |
$schema->storage->txn_rollback; |
65 |
}; |
67 |
}; |
66 |
|
68 |
|
|
|
69 |
subtest 'Testing Patron Info With Validate Patron Attribute' => sub { |
70 |
my $schema = Koha::Database->new->schema; |
71 |
$schema->storage->txn_begin; |
72 |
plan tests => 6; |
73 |
$C4::SIP::Sip::protocol_version = 2; |
74 |
test_request_patron_info_with_validate_patron_attribute(); |
75 |
$schema->storage->txn_rollback; |
76 |
}; |
77 |
|
67 |
subtest 'Checkin V2' => sub { |
78 |
subtest 'Checkin V2' => sub { |
68 |
my $schema = Koha::Database->new->schema; |
79 |
my $schema = Koha::Database->new->schema; |
69 |
$schema->storage->txn_begin; |
80 |
$schema->storage->txn_begin; |
Lines 232-237
sub test_request_patron_info_v2 {
Link Here
|
232 |
check_field( $respcode, $response, FID_SCREEN_MSG, '.+', 'But we have a screen msg', 'regex' ); |
243 |
check_field( $respcode, $response, FID_SCREEN_MSG, '.+', 'But we have a screen msg', 'regex' ); |
233 |
} |
244 |
} |
234 |
|
245 |
|
|
|
246 |
sub test_request_patron_info_with_validate_patron_attribute { |
247 |
my $builder = t::lib::TestBuilder->new(); |
248 |
my $branchcode = $builder->build({ source => 'Branch' })->{branchcode}; |
249 |
my ( $response, $findpatron ); |
250 |
my $mocks = create_mocks( \$response, \$findpatron, \$branchcode ); |
251 |
|
252 |
my $patron = $builder->build({ |
253 |
source => 'Borrower', |
254 |
value => { |
255 |
password => hash_password( PATRON_PW ), |
256 |
}, |
257 |
}); |
258 |
my $card = $patron->{cardnumber}; |
259 |
my $sip_patron = C4::SIP::ILS::Patron->new( $card ); |
260 |
$findpatron = $sip_patron; |
261 |
|
262 |
my $attr_type = $builder->build( { source => 'BorrowerAttributeType' } ); |
263 |
|
264 |
my $siprequest = PATRON_INFO. 'engYYYYMMDDZZZZHHMMSS'.'Y '. |
265 |
FID_INST_ID. $branchcode. '|'. |
266 |
FID_PATRON_ID. $card. '|'. |
267 |
FID_PATRON_PWD. PATRON_PW. '|'; |
268 |
my $msg = C4::SIP::Sip::MsgType->new( $siprequest, 0 ); |
269 |
|
270 |
my $server = { ils => $mocks->{ils} }; |
271 |
$server->{account}->{validate_patron_attribute} = $attr_type->{code}; |
272 |
|
273 |
# patron with no patron attribyte should be denied (charge->ok = 0) |
274 |
undef $response; |
275 |
$msg->handle_patron_info( $server ); |
276 |
my $charge_ok = substr( $response, 2, 1 ); |
277 |
is( $charge_ok, 'Y', 'charge denied' ); |
278 |
check_field( '64', $response, FID_PERSONAL_NAME, $patron->{surname}, 'Verified patron name', 'contains' ); |
279 |
check_field( '64', $response, FID_VALID_PATRON, 'Y', 'Verified code BL' ); |
280 |
check_field( '64', $response, FID_VALID_PATRON_PWD, 'Y', 'Verified code CQ' ); |
281 |
|
282 |
# patron with anything but 1 as attribute value should be denied (charge->ok = 0) |
283 |
undef $response; |
284 |
my $attribute = Koha::Patron::Attribute->new( |
285 |
{ borrowernumber => $patron->{borrowernumber}, |
286 |
code => $attr_type->{code}, |
287 |
attribute => "Foo", |
288 |
} |
289 |
); |
290 |
$msg->handle_patron_info( $server ); |
291 |
$charge_ok = substr( $response, 2, 1 ); |
292 |
is( $charge_ok, 'Y', 'charge denied' ); |
293 |
|
294 |
# patron with 1 as proper attribute should be allowed |
295 |
undef $response; |
296 |
$attribute->set({ attribute => 1 })->store; |
297 |
$msg->handle_patron_info( $server ); |
298 |
$charge_ok = substr( $response, 2, 1 ); |
299 |
is( $charge_ok, ' ', 'charge allowed' ); |
300 |
} |
301 |
|
302 |
|
235 |
sub test_checkin_v2 { |
303 |
sub test_checkin_v2 { |
236 |
my $builder = t::lib::TestBuilder->new(); |
304 |
my $builder = t::lib::TestBuilder->new(); |
237 |
my $branchcode = $builder->build({ source => 'Branch' })->{branchcode}; |
305 |
my $branchcode = $builder->build({ source => 'Branch' })->{branchcode}; |
238 |
- |
|
|