3 # Copyright 2015 Koha Development team
5 # This file is part of Koha
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Test
::More tests
=> 15;
26 use Koha
::Authority
::Types
;
28 use Koha
::IssuingRules
;
29 use Koha
::Patron
::Category
;
30 use Koha
::Patron
::Categories
;
34 use t
::lib
::TestBuilder
;
38 my $schema = Koha
::Database
->new->schema;
39 $schema->storage->txn_begin;
40 my $builder = t
::lib
::TestBuilder
->new;
42 is
( ref(Koha
::Authority
::Types
->find('')), 'Koha::Authority::Type', 'Koha::Objects->find should work if the primary key is an empty string' );
44 my @columns = Koha
::Patrons
->columns;
45 my $borrowernumber_exists = grep { /^borrowernumber$/ } @columns;
46 is
( $borrowernumber_exists, 1, 'Koha::Objects->columns should return the table columns' );
48 subtest
'find' => sub {
50 my $patron = $builder->build({source
=> 'Borrower'});
51 my $patron_object = Koha
::Patrons
->find( $patron->{borrowernumber
} );
52 is
( $patron_object->borrowernumber, $patron->{borrowernumber
}, '->find should return the correct object' );
54 eval { my @patrons = Koha
::Patrons
->find( $patron->{borrowernumber
} ); };
55 like
( $@
, qr
|^Cannot
use "->find" in list context
|, "->find should not be called in list context to avoid side-effects" );
57 # Test sending undef to find; should not generate a warning
58 warning_is
{ $patron = Koha
::Patrons
->find( undef ); }
59 "", "Sending undef does not trigger a DBIx warning";
60 warning_is
{ $patron = Koha
::Patrons
->find( undef, undef ); }
61 "", "Sending two undefs does not trigger a DBIx warning too";
64 subtest
'update' => sub {
67 $builder->build( { source
=> 'City', value
=> { city_country
=> 'UK' } } );
68 $builder->build( { source
=> 'City', value
=> { city_country
=> 'UK' } } );
69 $builder->build( { source
=> 'City', value
=> { city_country
=> 'UK' } } );
70 $builder->build( { source
=> 'City', value
=> { city_country
=> 'France' } } );
71 $builder->build( { source
=> 'City', value
=> { city_country
=> 'France' } } );
72 $builder->build( { source
=> 'City', value
=> { city_country
=> 'Germany' } } );
73 Koha
::Cities
->search( { city_country
=> 'UK' } )->update( { city_country
=> 'EU' } );
74 is
( Koha
::Cities
->search( { city_country
=> 'EU' } )->count, 3, 'Koha::Objects->update should have updated the 3 rows' );
75 is
( Koha
::Cities
->search( { city_country
=> 'UK' } )->count, 0, 'Koha::Objects->update should have updated the 3 rows' );
78 subtest
'reset' => sub {
81 my $patrons = Koha
::Patrons
->search;
82 my $first_borrowernumber = $patrons->next->borrowernumber;
83 my $second_borrowernumber = $patrons->next->borrowernumber;
84 is
( ref( $patrons->reset ), 'Koha::Patrons', 'Koha::Objects->reset should allow chaining' );
85 is
( ref( $patrons->reset->next ), 'Koha::Patron', 'Koha::Objects->reset should allow chaining' );
86 is
( $patrons->reset->next->borrowernumber, $first_borrowernumber, 'Koha::Objects->reset should work as expected');
89 subtest
'delete' => sub {
92 my $patron_1 = $builder->build({source
=> 'Borrower'});
93 my $patron_2 = $builder->build({source
=> 'Borrower'});
94 is
( Koha
::Patrons
->search({ -or => { borrowernumber
=> [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}]}})->delete, 2, '');
95 is
( Koha
::Patrons
->search({ -or => { borrowernumber
=> [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}]}})->count, 0, '');
98 subtest
'not_covered_yet' => sub {
100 warning_is
{ Koha
::Patrons
->search->not_covered_yet } { carped
=> 'The method not_covered_yet is not covered by tests' }, "If a method is not covered by tests, the AUTOLOAD method won't execute the method";
102 subtest
'new' => sub {
104 my $a_cat_code = 'A_CAT_CODE';
105 my $patron_category = Koha
::Patron
::Category
->new( { categorycode
=> $a_cat_code } )->store;
106 is
( Koha
::Patron
::Categories
->find($a_cat_code)->category_type, 'A', 'Koha::Object->new should set the default value' );
107 Koha
::Patron
::Categories
->find($a_cat_code)->delete;
108 $patron_category = Koha
::Patron
::Category
->new( { categorycode
=> $a_cat_code, category_type
=> undef } )->store;
109 is
( Koha
::Patron
::Categories
->find($a_cat_code)->category_type, 'A', 'Koha::Object->new should set the default value even if the argument exists but is not defined' );
110 Koha
::Patron
::Categories
->find($a_cat_code)->delete;
113 subtest
'find' => sub {
116 # check find on a single PK
117 my $patron = $builder->build({ source
=> 'Borrower' });
118 is
( Koha
::Patrons
->find($patron->{borrowernumber
})->surname,
119 $patron->{surname
}, "Checking an arbitrary patron column after find"
121 # check find with unique column
122 my $obj = Koha
::Patrons
->find($patron->{cardnumber
}, { key
=> 'cardnumber' });
123 is
( $obj->borrowernumber, $patron->{borrowernumber
},
124 'Find with unique column and key specified' );
125 # check find with an additional where clause in the attrs hash
126 # we do not expect to find something now
127 is
( Koha
::Patrons
->find(
128 $patron->{borrowernumber
},
129 { where
=> { surname
=> { '!=', $patron->{surname
} }}},
130 ), undef, 'Additional where clause in find call' );
132 # check find with a composite FK
133 my $rule = $builder->build({ source
=> 'Issuingrule' });
134 my @pk = ( $rule->{branchcode
}, $rule->{categorycode
}, $rule->{itemtype
} );
135 is
( ref(Koha
::IssuingRules
->find(@pk)), "Koha::IssuingRule",
136 'Find returned a Koha object for composite primary key' );
138 is
( Koha
::Patrons
->find(), undef, 'Find returns undef if no params passed' );
141 subtest
'search_related' => sub {
143 my $builder = t
::lib
::TestBuilder
->new;
144 my $patron_1 = $builder->build( { source
=> 'Borrower' } );
145 my $patron_2 = $builder->build( { source
=> 'Borrower' } );
146 my $libraries = Koha
::Patrons
->search( { -or => { borrowernumber
=> [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
} ] } } )->search_related('branchcode');
147 is
( ref( $libraries ), 'Koha::Libraries', 'Koha::Objects->search_related should return an instanciated Koha::Objects-based object' );
148 is
( $libraries->count, 2, 'Koha::Objects->search_related should work as expected' );
149 is
( $libraries->next->branchcode, $patron_1->{branchcode
}, 'Koha::Objects->search_related should work as expected' );
150 is
( $libraries->next->branchcode, $patron_2->{branchcode
}, 'Koha::Objects->search_related should work as expected' );
152 my @libraries = Koha
::Patrons
->search( { -or => { borrowernumber
=> [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
} ] } } )->search_related('branchcode');
153 is
( ref( $libraries[0] ), 'Koha::Library', 'Koha::Objects->search_related should return a list of Koha::Object-based objects' );
154 is
( scalar(@libraries), 2, 'Koha::Objects->search_related should work as expected' );
155 is
( $libraries[0]->branchcode, $patron_1->{branchcode
}, 'Koha::Objects->search_related should work as expected' );
156 is
( $libraries[1]->branchcode, $patron_2->{branchcode
}, 'Koha::Objects->search_related should work as expected' );
159 subtest
'single' => sub {
161 my $builder = t
::lib
::TestBuilder
->new;
162 my $patron_1 = $builder->build( { source
=> 'Borrower' } );
163 my $patron_2 = $builder->build( { source
=> 'Borrower' } );
164 my $patron = Koha
::Patrons
->search({}, { rows
=> 1 })->single;
165 is
(ref($patron), 'Koha::Patron', 'Koha::Objects->single returns a single Koha::Patron object.');
166 warning_like
{ Koha
::Patrons
->search->single } qr/SQL that returns multiple rows/,
167 "Warning is presented if single is used for a result with multiple rows.";
170 subtest
'last' => sub {
172 my $builder = t
::lib
::TestBuilder
->new;
173 my $patron_1 = $builder->build( { source
=> 'Borrower' } );
174 my $patron_2 = $builder->build( { source
=> 'Borrower' } );
175 my $last_patron = Koha
::Patrons
->search->last;
176 is
( $last_patron->borrowernumber, $patron_2->{borrowernumber
}, '->last should return the last inserted patron' );
177 $last_patron = Koha
::Patrons
->search({ borrowernumber
=> $patron_1->{borrowernumber
} })->last;
178 is
( $last_patron->borrowernumber, $patron_1->{borrowernumber
}, '->last should work even if there is only 1 result' );
179 $last_patron = Koha
::Patrons
->search({ surname
=> 'should_not_exist' })->last;
180 is
( $last_patron, undef, '->last should return undef if search does not return any results' );
183 subtest
'get_column' => sub {
185 my @cities = Koha
::Cities
->search;
186 my @city_names = map { $_->city_name } @cities;
187 is_deeply
( [ Koha
::Cities
->search->get_column('city_name') ], \
@city_names, 'Koha::Objects->get_column should be allowed' );
190 subtest
'Exceptions' => sub {
193 my $patron_borrowernumber = $builder->build({ source
=> 'Borrower' })->{ borrowernumber
};
194 my $patron = Koha
::Patrons
->find( $patron_borrowernumber );
197 $patron->blah('blah');
199 ok
( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
200 'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
204 $patron->set({ blah
=> 'blah' });
206 ok
( $_->isa('Koha::Exceptions::Object::PropertyNotFound'),
207 'Setting a non-existent property should raise a Koha::Exceptions::Object::PropertyNotFound exception' );
211 $schema->storage->txn_rollback;
213 subtest
'->is_paged and ->pager tests' => sub {
217 $schema->storage->txn_begin;
219 # Delete existing patrons
220 Koha
::Checkouts
->delete;
221 Koha
::Patrons
->delete;
224 $builder->build_object({ class => 'Koha::Patrons' });
227 # Non-paginated search
228 my $patrons = Koha
::Patrons
->search();
229 is
( $patrons->count, 10, 'Search returns all patrons' );
230 ok
( !$patrons->is_paged, 'Search is not paged' );
233 $patrons = Koha
::Patrons
->search( undef, { 'page' => 1, 'rows' => 3 } );
234 is
( $patrons->count, 3, 'Search returns only one page, 3 patrons' );
235 ok
( $patrons->is_paged, 'Search is paged' );
236 my $pager = $patrons->pager;
237 is
( ref($patrons->pager), 'DBIx::Class::ResultSet::Pager',
238 'Koha::Objects->pager returns a valid DBIx::Class object' );
240 $schema->storage->txn_rollback;