8 use Test
::More tests
=> 31;
10 use_ok
('Koha::Borrower::Debarments');
12 my $dbh = C4
::Context
->dbh;
13 $dbh->{AutoCommit
} = 0;
14 $dbh->{RaiseError
} = 1;
16 my $borrowernumber = AddMember
(
17 firstname
=> 'my firstname',
18 surname
=> 'my surname',
23 my $success = AddDebarment
({
24 borrowernumber
=> $borrowernumber,
25 expiration
=> '9999-06-10',
29 is
( $success, 1, "AddDebarment returned true" );
32 my $debarments = GetDebarments
({ borrowernumber
=> $borrowernumber });
33 is
( @
$debarments, 1, "GetDebarments returns 1 debarment" );
34 is
( $debarments->[0]->{'type'}, 'MANUAL', "Correctly stored 'type'" );
35 is
( $debarments->[0]->{'expiration'}, '9999-06-10', "Correctly stored 'expiration'" );
36 is
( $debarments->[0]->{'comment'}, 'Test 1', "Correctly stored 'comment'" );
39 $success = AddDebarment
({
40 borrowernumber
=> $borrowernumber,
44 $debarments = GetDebarments
({ borrowernumber
=> $borrowernumber });
45 is
( @
$debarments, 2, "GetDebarments returns 2 debarments" );
46 is
( $debarments->[1]->{'type'}, 'MANUAL', "Correctly stored 'type'" );
47 is
( $debarments->[1]->{'expiration'}, undef, "Correctly stored debarrment with no expiration" );
48 is
( $debarments->[1]->{'comment'}, 'Test 2', "Correctly stored 'comment'" );
52 borrower_debarment_id
=> $debarments->[1]->{'borrower_debarment_id'},
54 expiration
=> '9998-06-10',
56 $debarments = GetDebarments
({ borrowernumber
=> $borrowernumber });
57 is
( $debarments->[1]->{'comment'}, 'Test 3', "ModDebarment functions correctly" );
60 my $borrower = GetMember
( borrowernumber
=> $borrowernumber );
61 is
( $borrower->{'debarred'}, '9999-06-10', "Field borrowers.debarred set correctly" );
62 is
( $borrower->{'debarredcomment'}, "Test 1\nTest 3", "Field borrowers.debarredcomment set correctly" );
66 borrowernumber
=> $borrowernumber,
69 $debarments = GetDebarments
({
70 borrowernumber
=> $borrowernumber,
73 is
( @
$debarments, 1, "GetDebarments returns 1 OVERDUES debarment" );
74 is
( $debarments->[0]->{'type'}, 'OVERDUES', "AddOverduesDebarment created new debarment correctly" );
77 borrowernumber
=> $borrowernumber,
78 expiration
=> '9999-11-09',
81 $debarments = GetDebarments
({
82 borrowernumber
=> $borrowernumber,
85 is
( @
$debarments, 1, "GetDebarments returns 1 OVERDUES debarment after running AddOverduesDebarment twice" );
86 is
( $debarments->[0]->{'expiration'}, '9999-11-09', "AddOverduesDebarment updated OVERDUES debarment correctly" );
89 my $delUniqueDebarment = DelUniqueDebarment
({
91 is
( $delUniqueDebarment, undef, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' returns undef" );
92 $debarments = GetDebarments
({
93 borrowernumber
=> $borrowernumber,
96 is
( @
$debarments, 1, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' does not delete the debarment" );
98 $delUniqueDebarment = DelUniqueDebarment
({
99 borrowernumber
=> $borrowernumber,
101 is
( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'type' returns undef" );
102 $debarments = GetDebarments
({
103 borrowernumber
=> $borrowernumber,
106 is
( @
$debarments, 1, "DelUniqueDebarment without the argument 'type' does not delete the debarment" );
108 $delUniqueDebarment = DelUniqueDebarment
({
111 is
( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'borrowernumber' returns undef" );
112 $debarments = GetDebarments
({
113 borrowernumber
=> $borrowernumber,
116 is
( @
$debarments, 1, "DelUniqueDebarment without the argument 'borrowerumber' does not delete the debarment" );
118 $delUniqueDebarment = DelUniqueDebarment
({
119 borrowernumber
=> $borrowernumber,
120 type
=> 'SUSPENSION',
122 is
( $delUniqueDebarment, undef, "DelUniqueDebarment with wrong arguments returns undef" );
123 $debarments = GetDebarments
({
124 borrowernumber
=> $borrowernumber,
127 is
( @
$debarments, 1, "DelUniqueDebarment with wrong arguments does not delete the debarment" );
129 $delUniqueDebarment = DelUniqueDebarment
({
130 borrowernumber
=> $borrowernumber,
133 is
( $delUniqueDebarment, 1, "DelUniqueDebarment returns 1" );
134 $debarments = GetDebarments
({
135 borrowernumber
=> $borrowernumber,
138 is
( @
$debarments, 0, "DelUniqueDebarment functions correctly" );
141 $debarments = GetDebarments
({ borrowernumber
=> $borrowernumber });
142 foreach my $d ( @
$debarments ) {
143 DelDebarment
( $d->{'borrower_debarment_id'} );
145 $debarments = GetDebarments
({ borrowernumber
=> $borrowernumber });
146 is
( @
$debarments, 0, "DelDebarment functions correctly" );
148 $dbh->do(q
|UPDATE borrowers SET debarred
= '1970-01-01'|);
149 is
( IsDebarred
( $borrowernumber ), undef, 'A patron with a debarred date in the past is not debarred' );
151 $dbh->do(q
|UPDATE borrowers SET debarred
= NULL
|);
152 is
( IsDebarred
( $borrowernumber ), undef, 'A patron without a debarred date is not debarred' );
154 $dbh->do(q
|UPDATE borrowers SET debarred
= '9999-12-31'|); # Note: Change this test before the first of January 10000!
155 is
( IsDebarred
( $borrowernumber ), '9999-12-31', 'A patron with a debarred date in the future is debarred' );