3 # This file is part of Koha.
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Test
::More tests
=> 11;
26 use C4
::Biblio
; # AddBiblio
27 use C4
::Circulation
; # AddIssue
28 use C4
::Members
;# AddMember
30 use Koha
::DateUtils
qw( dt_from_string );
33 use Scalar
::Util
qw( isvstring );
36 use t
::lib
::TestBuilder
;
39 use_ok
('Koha::Object');
40 use_ok
('Koha::Patron');
43 my $schema = Koha
::Database
->new->schema;
44 my $builder = t
::lib
::TestBuilder
->new();
46 subtest
'is_changed / make_column_dirty' => sub {
49 $schema->storage->txn_begin;
51 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
52 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
54 my $object = Koha
::Patron
->new();
55 $object->categorycode( $categorycode );
56 $object->branchcode( $branchcode );
57 $object->surname("Test Surname");
59 is
( $object->is_changed(), 0, "Object is unchanged" );
60 $object->surname("Test Surname");
61 is
( $object->is_changed(), 0, "Object is still unchanged" );
62 $object->surname("Test Surname 2");
63 is
( $object->is_changed(), 1, "Object is changed" );
66 is
( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
68 $object->set({ firstname
=> 'Test Firstname' });
69 is
( $object->is_changed(), 1, "Object is changed after Set" );
71 is
( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
73 # Test make_column_dirty
74 is
( $object->make_column_dirty('firstname'), '', 'make_column_dirty returns empty string on success' );
75 is
( $object->make_column_dirty('firstname'), 1, 'make_column_dirty returns 1 if already dirty' );
76 is
( $object->is_changed, 1, "Object is changed after make dirty" );
78 is
( $object->is_changed, 0, "Store clears dirty mark" );
79 $object->make_column_dirty('firstname');
80 $object->discard_changes;
81 is
( $object->is_changed, 0, "Discard clears dirty mark too" );
83 $schema->storage->txn_rollback;
86 subtest
'in_storage' => sub {
89 $schema->storage->txn_begin;
91 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
92 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
94 my $object = Koha
::Patron
->new();
95 is
( $object->in_storage, 0, "Object is not in storage" );
96 $object->categorycode( $categorycode );
97 $object->branchcode( $branchcode );
98 $object->surname("Test Surname");
100 is
( $object->in_storage, 1, "Object is now stored" );
101 $object->surname("another surname");
102 is
( $object->in_storage, 1 );
104 my $borrowernumber = $object->borrowernumber;
105 my $patron = $schema->resultset('Borrower')->find( $borrowernumber );
106 is
( $patron->surname(), "Test Surname", "Object found in database" );
109 $patron = $schema->resultset('Borrower')->find( $borrowernumber );
110 ok
( ! $patron, "Object no longer found in database" );
111 is
( $object->in_storage, 0, "Object is not in storage" );
113 $schema->storage->txn_rollback;
116 subtest
'id' => sub {
119 $schema->storage->txn_begin;
121 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
122 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
124 my $patron = Koha
::Patron
->new({categorycode
=> $categorycode, branchcode
=> $branchcode })->store;
125 is
( $patron->id, $patron->borrowernumber );
127 $schema->storage->txn_rollback;
130 subtest
'get_column' => sub {
133 $schema->storage->txn_begin;
135 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
136 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
138 my $patron = Koha
::Patron
->new({categorycode
=> $categorycode, branchcode
=> $branchcode })->store;
139 is
( $patron->get_column('borrowernumber'), $patron->borrowernumber, 'get_column should retrieve the correct value' );
141 $schema->storage->txn_rollback;
144 subtest
'discard_changes' => sub {
147 $schema->storage->txn_begin;
149 my $patron = $builder->build( { source
=> 'Borrower' } );
150 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
151 $patron->dateexpiry(dt_from_string
);
152 $patron->discard_changes;
154 dt_from_string
( $patron->dateexpiry ),
155 dt_from_string
->truncate( to
=> 'day' ),
156 'discard_changes should refresh the object'
159 $schema->storage->txn_rollback;
162 subtest
'TO_JSON tests' => sub {
166 $schema->storage->txn_begin;
168 my $dt = dt_from_string
();
169 my $borrowernumber = $builder->build(
170 { source
=> 'Borrower',
171 value
=> { lost
=> 1,
174 lastseen
=> $dt, } })->{borrowernumber
};
176 my $patron = Koha
::Patrons
->find($borrowernumber);
177 my $lost = $patron->TO_JSON()->{lost
};
178 my $gonenoaddress = $patron->TO_JSON->{gonenoaddress
};
179 my $updated_on = $patron->TO_JSON->{updated_on
};
180 my $lastseen = $patron->TO_JSON->{lastseen
};
182 ok
( $lost->isa('JSON::PP::Boolean'), 'Boolean attribute type is correct' );
183 is
( $lost, 1, 'Boolean attribute value is correct (true)' );
185 ok
( $gonenoaddress->isa('JSON::PP::Boolean'), 'Boolean attribute type is correct' );
186 is
( $gonenoaddress, 0, 'Boolean attribute value is correct (false)' );
188 ok
( !isvstring
($patron->borrowernumber), 'Integer values are not coded as strings' );
190 my $rfc3999_regex = qr
/
202 (([Zz
])|([\
+|\
-]([01][0-9]|2[0-3]):[0-5][0-9]))
204 like
( $updated_on, $rfc3999_regex, "Date-time $updated_on formatted correctly");
205 like
( $lastseen, $rfc3999_regex, "Date-time $updated_on formatted correctly");
207 $schema->storage->txn_rollback;
210 subtest
"Test update method" => sub {
213 $schema->storage->txn_begin;
215 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
216 my $library = Koha
::Libraries
->find( $branchcode );
217 $library->update({ branchname
=> 'New_Name', branchcity
=> 'AMS' });
218 is
( $library->branchname, 'New_Name', 'Changed name with update' );
219 is
( $library->branchcity, 'AMS', 'Changed city too' );
220 is
( $library->is_changed, 0, 'Change should be stored already' );
223 branchcity
=> 'NYC', not_a_column
=> 53, branchname
=> 'Name3',
225 fail
( 'It should not be possible to update an unexisting column without an error from Koha::Object/DBIx' );
227 ok
( $_->isa('Koha::Exceptions::Object'), 'Caught error when updating wrong column' );
228 $library->discard_changes; #requery after failing update
230 # Check if the columns are not updated
231 is
( $library->branchcity, 'AMS', 'First column not updated' );
232 is
( $library->branchname, 'New_Name', 'Third column not updated' );
234 $schema->storage->txn_rollback;
237 subtest
'store() tests' => sub {
241 $schema->storage->txn_begin;
243 # Create a category to make sure its ID doesn't exist on the DB
244 my $category = $builder->build_object({ class => 'Koha::Patron::Categories' });
245 my $category_id = $category->id;
248 my $patron = Koha
::Patron
->new({ categorycode
=> $category_id });
250 my $print_error = $schema->storage->dbh->{PrintError
};
251 $schema->storage->dbh->{PrintError
} = 0;
254 'Koha::Exceptions::Object::FKConstraint',
255 'Exception is thrown correctly';
258 "Broken FK constraint",
259 'Exception message is correct'
264 'Exception field is correct'
267 my $library = $builder->build_object({ class => 'Koha::Libraries' });
268 $category = $builder->build_object({ class => 'Koha::Patron::Categories' });
269 $patron = $builder->build_object({ class => 'Koha::Patrons' });
271 my $new_patron = Koha
::Patron
->new({
272 branchcode
=> $library->id,
273 cardnumber
=> $patron->cardnumber,
274 categorycode
=> $category->id
278 { $new_patron->store }
279 'Koha::Exceptions::Object::DuplicateID',
280 'Exception is thrown correctly';
285 'Exception message is correct'
291 'Exception field is correct'
294 $new_patron = Koha
::Patron
->new({
295 branchcode
=> $library->id,
296 userid
=> $patron->userid,
297 categorycode
=> $category->id
301 { $new_patron->store }
302 'Koha::Exceptions::Object::DuplicateID',
303 'Exception is thrown correctly';
308 'Exception message is correct'
314 'Exception field is correct'
317 $schema->storage->dbh->{PrintError
} = $print_error;
320 $patron->set({ firstname
=> 'Manuel' });
321 my $ret = $patron->store;
322 is
( ref($ret), 'Koha::Patron', 'store() returns the object on success' );
324 $schema->storage->txn_rollback;
327 subtest
'unblessed_all_relateds' => sub {
330 $schema->storage->txn_begin;
332 # FIXME It's very painful to create an issue in tests!
333 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
334 C4
::Context
->_new_userenv('xxx');
335 C4
::Context
->set_userenv(0,0,0,'firstname','surname', $library->branchcode, 'Midway Public Library', '', '', '');
336 my $patron_category = $builder->build(
338 source
=> 'Category',
340 category_type
=> 'P',
342 BlockExpiredPatronOpacActions
=> -1, # Pick the pref value
347 firstname
=> 'firstname',
348 surname
=> 'surname',
349 categorycode
=> $patron_category->{categorycode
},
350 branchcode
=> $library->branchcode,
352 my $borrowernumber = C4
::Members
::AddMember
(%$patron_data);
353 my $patron = Koha
::Patrons
->find( $borrowernumber );
354 my ($biblionumber) = AddBiblio
( MARC
::Record
->new, '' );
355 my $biblio = Koha
::Biblios
->find( $biblionumber );
356 my $item = $builder->build_object(
358 class => 'Koha::Items',
360 homebranch
=> $library->branchcode,
361 holdingbranch
=> $library->branchcode,
362 biblionumber
=> $biblio->biblionumber,
369 my $issue = AddIssue
( $patron->unblessed, $item->barcode, DateTime
->now->subtract( days
=> 1 ) );
370 my $overdues = Koha
::Patrons
->find( $patron->id )->get_overdues; # Koha::Patron->get_overdue prefetches
371 my $overdue = $overdues->next->unblessed_all_relateds;
372 is
( $overdue->{issue_id
}, $issue->issue_id, 'unblessed_all_relateds has field from the original table (issues)' );
373 is
( $overdue->{title
}, $biblio->title, 'unblessed_all_relateds has field from other tables (biblio)' );
374 is
( $overdue->{homebranch
}, $item->homebranch, 'unblessed_all_relateds has field from other tables (items)' );
376 $schema->storage->txn_rollback;