Bug 28519: Put CGI::Session::Serialize::yamlxs in lib directory
[koha.git] / t / db_dependent / Patron / Borrower_Debarments.t
1 #!/usr/bin/perl
2
3 use Modern::Perl;
4
5 use C4::Context;
6 use Koha::Database;
7 use Koha::Patrons;
8
9 use t::lib::TestBuilder;
10
11 use Test::More tests => 33;
12
13 use_ok('Koha::Patron::Debarments');
14
15 my $schema = Koha::Database->schema;
16 $schema->storage->txn_begin;
17 my $builder = t::lib::TestBuilder->new;
18 my $dbh = C4::Context->dbh;
19
20 my $library = $builder->build({
21     source => 'Branch',
22 });
23
24 my $patron_category = $builder->build({ source => 'Category' });
25 my $borrowernumber = Koha::Patron->new({
26     firstname =>  'my firstname',
27     surname => 'my surname',
28     categorycode => $patron_category->{categorycode},
29     branchcode => $library->{branchcode},
30 })->store->borrowernumber;
31
32 my $success = AddDebarment({
33     borrowernumber => $borrowernumber,
34     expiration => '9999-06-10',
35     type => 'MANUAL',
36     comment => 'Test 1',
37 });
38 is( $success, 1, "AddDebarment returned true" );
39
40
41 my $debarments = GetDebarments({ borrowernumber => $borrowernumber });
42 is( @$debarments, 1, "GetDebarments returns 1 debarment" );
43 is( $debarments->[0]->{'type'}, 'MANUAL', "Correctly stored 'type'" );
44 is( $debarments->[0]->{'expiration'}, '9999-06-10', "Correctly stored 'expiration'" );
45 is( $debarments->[0]->{'comment'}, 'Test 1', "Correctly stored 'comment'" );
46
47
48 $success = AddDebarment({
49     borrowernumber => $borrowernumber,
50     comment => 'Test 2',
51 });
52
53 $debarments = GetDebarments({ borrowernumber => $borrowernumber });
54 is( @$debarments, 2, "GetDebarments returns 2 debarments" );
55 is( $debarments->[1]->{'type'}, 'MANUAL', "Correctly stored 'type'" );
56 is( $debarments->[1]->{'expiration'}, undef, "Correctly stored debarrment with no expiration" );
57 is( $debarments->[1]->{'comment'}, 'Test 2', "Correctly stored 'comment'" );
58
59
60 ModDebarment({
61     borrower_debarment_id => $debarments->[1]->{'borrower_debarment_id'},
62     comment => 'Test 3',
63     expiration => '9998-06-10',
64 });
65 $debarments = GetDebarments({ borrowernumber => $borrowernumber });
66 is( $debarments->[1]->{'comment'}, 'Test 3', "ModDebarment functions correctly" );
67
68 my $patron = Koha::Patrons->find( $borrowernumber )->unblessed;
69 is( $patron->{'debarred'}, '9999-06-10', "Field borrowers.debarred set correctly" );
70 is( $patron->{'debarredcomment'}, "Test 1\nTest 3", "Field borrowers.debarredcomment set correctly" );
71
72
73 AddUniqueDebarment({
74     borrowernumber => $borrowernumber,
75     type           => 'OVERDUES'
76 });
77 $debarments = GetDebarments({
78     borrowernumber => $borrowernumber,
79     type => 'OVERDUES',
80 });
81 is( @$debarments, 1, "GetDebarments returns 1 OVERDUES debarment" );
82 is( $debarments->[0]->{'type'}, 'OVERDUES', "AddOverduesDebarment created new debarment correctly" );
83
84 AddUniqueDebarment({
85     borrowernumber => $borrowernumber,
86     expiration => '9999-11-09',
87     type => 'OVERDUES'
88 });
89 $debarments = GetDebarments({
90     borrowernumber => $borrowernumber,
91     type => 'OVERDUES',
92 });
93 is( @$debarments, 1, "GetDebarments returns 1 OVERDUES debarment after running AddOverduesDebarment twice" );
94 is( $debarments->[0]->{'expiration'}, '9999-11-09', "AddOverduesDebarment updated OVERDUES debarment correctly" );
95
96
97 my $delUniqueDebarment = DelUniqueDebarment({
98 });
99 is( $delUniqueDebarment, undef, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' returns undef" );
100 $debarments = GetDebarments({
101     borrowernumber => $borrowernumber,
102     type => 'OVERDUES',
103 });
104 is( @$debarments, 1, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' does not delete the debarment" );
105
106 $delUniqueDebarment = DelUniqueDebarment({
107     borrowernumber => $borrowernumber,
108 });
109 is( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'type' returns undef" );
110 $debarments = GetDebarments({
111     borrowernumber => $borrowernumber,
112     type => 'OVERDUES',
113 });
114 is( @$debarments, 1, "DelUniqueDebarment without the argument 'type' does not delete the debarment" );
115
116 $delUniqueDebarment = DelUniqueDebarment({
117     type => 'OVERDUES'
118 });
119 is( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'borrowernumber' returns undef" );
120 $debarments = GetDebarments({
121     borrowernumber => $borrowernumber,
122     type => 'OVERDUES',
123 });
124 is( @$debarments, 1, "DelUniqueDebarment without the argument 'borrowerumber' does not delete the debarment" );
125
126 $delUniqueDebarment = DelUniqueDebarment({
127     borrowernumber => $borrowernumber,
128     type => 'SUSPENSION',
129 });
130 is( $delUniqueDebarment, undef, "DelUniqueDebarment with wrong arguments returns undef" );
131 $debarments = GetDebarments({
132     borrowernumber => $borrowernumber,
133     type => 'OVERDUES',
134 });
135 is( @$debarments, 1, "DelUniqueDebarment with wrong arguments does not delete the debarment" );
136
137 $delUniqueDebarment = DelUniqueDebarment({
138     borrowernumber => $borrowernumber,
139     type => 'OVERDUES',
140 });
141 is( $delUniqueDebarment, 1, "DelUniqueDebarment returns 1" );
142 $debarments = GetDebarments({
143     borrowernumber => $borrowernumber,
144     type => 'OVERDUES',
145 });
146 is( @$debarments, 0, "DelUniqueDebarment functions correctly" );
147
148
149 $debarments = GetDebarments({ borrowernumber => $borrowernumber });
150 foreach my $d ( @$debarments ) {
151     DelDebarment( $d->{'borrower_debarment_id'} );
152 }
153 $debarments = GetDebarments({ borrowernumber => $borrowernumber });
154 is( @$debarments, 0, "DelDebarment functions correctly" );
155
156 $dbh->do(q|UPDATE borrowers SET debarred = '1970-01-01'|);
157 is( Koha::Patrons->find( $borrowernumber )->is_debarred, undef, 'A patron with a debarred date in the past is not debarred' );
158
159 $dbh->do(q|UPDATE borrowers SET debarred = NULL|);
160 is( Koha::Patrons->find( $borrowernumber )->is_debarred, undef, 'A patron without a debarred date is not debarred' );
161
162 $dbh->do(q|UPDATE borrowers SET debarred = '9999-12-31'|); # Note: Change this test before the first of January 10000!
163 is( Koha::Patrons->find( $borrowernumber )->is_debarred, '9999-12-31', 'A patron with a debarred date in the future is debarred' );
164
165 # Test patrons merge
166 my $borrowernumber2 = Koha::Patron->new(
167     {
168         firstname    => 'my firstname bis',
169         surname      => 'my surname bis',
170         categorycode => $patron_category->{categorycode},
171         branchcode   => $library->{branchcode},
172     }
173 )->store->borrowernumber;
174 my $debarreddate2    = '9999-06-10'; # Be sure to be in the future
175 my $debarredcomment2 = 'Test merge';
176 AddDebarment(
177     {
178         borrowernumber => $borrowernumber2,
179         expiration     => $debarreddate2,
180         type           => 'MANUAL',
181         comment        => $debarredcomment2,
182     }
183 );
184 my $borrowernumber3 = Koha::Patron->new(
185     {
186         firstname    => 'my firstname ter',
187         surname      => 'my surname ter',
188         categorycode => $patron_category->{categorycode},
189         branchcode   => $library->{branchcode},
190     }
191 )->store->borrowernumber;
192 Koha::Patrons->find($borrowernumber3)->merge_with( [$borrowernumber2] );
193 is( Koha::Patrons->find($borrowernumber3)->debarred,
194     $debarreddate2, 'Koha::Patron->merge_with() transfers well debarred' );
195 is( Koha::Patrons->find($borrowernumber3)->debarredcomment,
196     $debarredcomment2, 'Koha::Patron->merge_with() transfers well debarredcomment' );