t/db_dependent/Koha/Object.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   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.
   9 #
  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.
  14 #
  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>.
  17
  18 use Modern::Perl;
  19
  20 use Test::More tests => 11;
  21 use Test::Exception;
  22 use Test::Warn;
  23 use DateTime;
  24
  25 use C4::Context;
  26 use C4::Biblio; # AddBiblio
  27 use C4::Circulation; # AddIssue
  28 use Koha::Database;
  29 use Koha::DateUtils qw( dt_from_string );
  30 use Koha::Libraries;
  31 use Koha::Patrons;
  32
  33 use Scalar::Util qw( isvstring );
  34 use Try::Tiny;
  35
  36 use t::lib::TestBuilder;
  37
  38 BEGIN {
  39     use_ok('Koha::Object');
  40     use_ok('Koha::Patron');
  41 }
  42
  43 my $schema  = Koha::Database->new->schema;
  44 my $builder = t::lib::TestBuilder->new();
  45
  46 subtest 'is_changed / make_column_dirty' => sub {
  47     plan tests => 11;
  48
  49     $schema->storage->txn_begin;
  50
  51     my $categorycode = $builder->build({ source => 'Category' })->{categorycode};
  52     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
  53
  54     my $object = Koha::Patron->new();
  55     $object->categorycode( $categorycode );
  56     $object->branchcode( $branchcode );
  57     $object->surname("Test Surname");
  58     $object->store();
  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" );
  64
  65     $object->store();
  66     is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
  67
  68     $object->set({ firstname => 'Test Firstname' });
  69     is( $object->is_changed(), 1, "Object is changed after Set" );
  70     $object->store();
  71     is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
  72
  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" );
  77     $object->store;
  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" );
  82
  83     $schema->storage->txn_rollback;
  84 };
  85
  86 subtest 'in_storage' => sub {
  87     plan tests => 6;
  88
  89     $schema->storage->txn_begin;
  90
  91     my $categorycode = $builder->build({ source => 'Category' })->{categorycode};
  92     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
  93
  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");
  99     $object->store();
 100     is( $object->in_storage, 1, "Object is now stored" );
 101     $object->surname("another surname");
 102     is( $object->in_storage, 1 );
 103
 104     my $borrowernumber = $object->borrowernumber;
 105     my $patron = $schema->resultset('Borrower')->find( $borrowernumber );
 106     is( $patron->surname(), "Test Surname", "Object found in database" );
 107
 108     $object->delete();
 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" );
 112
 113     $schema->storage->txn_rollback;
 114 };
 115
 116 subtest 'id' => sub {
 117     plan tests => 1;
 118
 119     $schema->storage->txn_begin;
 120
 121     my $categorycode = $builder->build({ source => 'Category' })->{categorycode};
 122     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
 123
 124     my $patron = Koha::Patron->new({categorycode => $categorycode, branchcode => $branchcode })->store;
 125     is( $patron->id, $patron->borrowernumber );
 126
 127     $schema->storage->txn_rollback;
 128 };
 129
 130 subtest 'get_column' => sub {
 131     plan tests => 1;
 132
 133     $schema->storage->txn_begin;
 134
 135     my $categorycode = $builder->build({ source => 'Category' })->{categorycode};
 136     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
 137
 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' );
 140
 141     $schema->storage->txn_rollback;
 142 };
 143
 144 subtest 'discard_changes' => sub {
 145     plan tests => 1;
 146
 147     $schema->storage->txn_begin;
 148
 149     my $patron = $builder->build( { source => 'Borrower' } );
 150     $patron = Koha::Patrons->find( $patron->{borrowernumber} );
 151     $patron->dateexpiry(dt_from_string);
 152     $patron->discard_changes;
 153     is(
 154         dt_from_string( $patron->dateexpiry ),
 155         dt_from_string->truncate( to => 'day' ),
 156         'discard_changes should refresh the object'
 157     );
 158
 159     $schema->storage->txn_rollback;
 160 };
 161
 162 subtest 'TO_JSON tests' => sub {
 163
 164     plan tests => 8;
 165
 166     $schema->storage->txn_begin;
 167
 168     my $dt = dt_from_string();
 169     my $borrowernumber = $builder->build(
 170         { source => 'Borrower',
 171           value => { lost => 1,
 172                      sms_provider_id => undef,
 173                      gonenoaddress => 0,
 174                      updated_on => $dt,
 175                      lastseen   => $dt, } })->{borrowernumber};
 176
 177     my $patron = Koha::Patrons->find($borrowernumber);
 178     my $lost = $patron->TO_JSON()->{lost};
 179     my $gonenoaddress = $patron->TO_JSON->{gonenoaddress};
 180     my $updated_on = $patron->TO_JSON->{updated_on};
 181     my $lastseen = $patron->TO_JSON->{lastseen};
 182
 183     ok( $lost->isa('JSON::PP::Boolean'), 'Boolean attribute type is correct' );
 184     is( $lost, 1, 'Boolean attribute value is correct (true)' );
 185
 186     ok( $gonenoaddress->isa('JSON::PP::Boolean'), 'Boolean attribute type is correct' );
 187     is( $gonenoaddress, 0, 'Boolean attribute value is correct (false)' );
 188
 189     is( $patron->TO_JSON->{sms_provider_id}, undef, 'Undef values should not be casted to 0' );
 190
 191     ok( !isvstring($patron->borrowernumber), 'Integer values are not coded as strings' );
 192
 193     my $rfc3999_regex = qr/
 194             (?<year>\d{4})
 195             -
 196             (?<month>\d{2})
 197             -
 198             (?<day>\d{2})
 199             ([Tt\s])
 200             (?<hour>\d{2})
 201             :
 202             (?<minute>\d{2})
 203             :
 204             (?<second>\d{2})
 205             (([Zz])|([\+|\-]([01][0-9]|2[0-3]):[0-5][0-9]))
 206         /xms;
 207     like( $updated_on, $rfc3999_regex, "Date-time $updated_on formatted correctly");
 208     like( $lastseen, $rfc3999_regex, "Date-time $updated_on formatted correctly");
 209
 210     $schema->storage->txn_rollback;
 211 };
 212
 213 subtest "Test update method" => sub {
 214     plan tests => 6;
 215
 216     $schema->storage->txn_begin;
 217
 218     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
 219     my $library = Koha::Libraries->find( $branchcode );
 220     $library->update({ branchname => 'New_Name', branchcity => 'AMS' });
 221     is( $library->branchname, 'New_Name', 'Changed name with update' );
 222     is( $library->branchcity, 'AMS', 'Changed city too' );
 223     is( $library->is_changed, 0, 'Change should be stored already' );
 224     try {
 225         $library->update({
 226             branchcity => 'NYC', not_a_column => 53, branchname => 'Name3',
 227         });
 228         fail( 'It should not be possible to update an unexisting column without an error from Koha::Object/DBIx' );
 229     } catch {
 230         ok( $_->isa('Koha::Exceptions::Object'), 'Caught error when updating wrong column' );
 231         $library->discard_changes; #requery after failing update
 232     };
 233     # Check if the columns are not updated
 234     is( $library->branchcity, 'AMS', 'First column not updated' );
 235     is( $library->branchname, 'New_Name', 'Third column not updated' );
 236
 237     $schema->storage->txn_rollback;
 238 };
 239
 240 subtest 'store() tests' => sub {
 241
 242     plan tests => 10;
 243
 244     $schema->storage->txn_begin;
 245
 246     # Create a category to make sure its ID doesn't exist on the DB
 247     my $category = $builder->build_object({ class => 'Koha::Patron::Categories' });
 248     my $category_id = $category->id;
 249     $category->delete;
 250
 251     my $patron = Koha::Patron->new({ categorycode => $category_id });
 252
 253     my $print_error = $schema->storage->dbh->{PrintError};
 254     $schema->storage->dbh->{PrintError} = 0; # FIXME This does not longer work - because of the transaction in Koha::Patron->store?
 255     throws_ok
 256         { $patron->store }
 257         'Koha::Exceptions::Object::FKConstraint',
 258         'Exception is thrown correctly';
 259     is(
 260         $@->message,
 261         "Broken FK constraint",
 262         'Exception message is correct'
 263     );
 264     is(
 265         $@->broken_fk,
 266         'categorycode',
 267         'Exception field is correct'
 268     );
 269
 270     my $library = $builder->build_object({ class => 'Koha::Libraries' });
 271     $category   = $builder->build_object({ class => 'Koha::Patron::Categories' });
 272     $patron     = $builder->build_object({ class => 'Koha::Patrons' });
 273
 274     my $new_patron = Koha::Patron->new({
 275         branchcode   => $library->id,
 276         cardnumber   => $patron->cardnumber,
 277         categorycode => $category->id
 278     });
 279
 280     throws_ok
 281         { $new_patron->store }
 282         'Koha::Exceptions::Object::DuplicateID',
 283         'Exception is thrown correctly';
 284
 285     is(
 286         $@->message,
 287         'Duplicate ID',
 288         'Exception message is correct'
 289     );
 290
 291     is(
 292        $@->duplicate_id,
 293        'cardnumber',
 294        'Exception field is correct'
 295     );
 296
 297     $new_patron = Koha::Patron->new({
 298         branchcode   => $library->id,
 299         userid       => $patron->userid,
 300         categorycode => $category->id
 301     });
 302
 303     throws_ok
 304         { $new_patron->store }
 305         'Koha::Exceptions::Object::DuplicateID',
 306         'Exception is thrown correctly';
 307
 308     is(
 309         $@->message,
 310         'Duplicate ID',
 311         'Exception message is correct'
 312     );
 313
 314     is(
 315        $@->duplicate_id,
 316        'userid',
 317        'Exception field is correct'
 318     );
 319
 320     $schema->storage->dbh->{PrintError} = $print_error;
 321
 322     # Successful test
 323     $patron->set({ firstname => 'Manuel' });
 324     my $ret = $patron->store;
 325     is( ref($ret), 'Koha::Patron', 'store() returns the object on success' );
 326
 327     $schema->storage->txn_rollback;
 328 };
 329
 330 subtest 'unblessed_all_relateds' => sub {
 331     plan tests => 3;
 332
 333     $schema->storage->txn_begin;
 334
 335     # FIXME It's very painful to create an issue in tests!
 336     my $library = $builder->build_object( { class => 'Koha::Libraries' } );
 337     C4::Context->_new_userenv('xxx');
 338     C4::Context->set_userenv(0,0,0,'firstname','surname', $library->branchcode, 'Midway Public Library', '', '', '');
 339     my $patron_category = $builder->build(
 340         {
 341             source => 'Category',
 342             value  => {
 343                 category_type                 => 'P',
 344                 enrolmentfee                  => 0,
 345                 BlockExpiredPatronOpacActions => -1, # Pick the pref value
 346             }
 347         }
 348     );
 349     my $patron_data = {
 350         firstname =>  'firstname',
 351         surname => 'surname',
 352         categorycode => $patron_category->{categorycode},
 353         branchcode => $library->branchcode,
 354     };
 355     my $patron = Koha::Patron->new($patron_data)->store;
 356     my ($biblionumber) = AddBiblio( MARC::Record->new, '' );
 357     my $biblio = Koha::Biblios->find( $biblionumber );
 358     my $item = $builder->build_object(
 359         {
 360             class => 'Koha::Items',
 361             value => {
 362                 homebranch    => $library->branchcode,
 363                 holdingbranch => $library->branchcode,
 364                 biblionumber  => $biblio->biblionumber,
 365                 itemlost      => 0,
 366                 withdrawn     => 0,
 367             }
 368         }
 369     );
 370
 371     my $issue = AddIssue( $patron->unblessed, $item->barcode, DateTime->now->subtract( days => 1 ) );
 372     my $overdues = Koha::Patrons->find( $patron->id )->get_overdues; # Koha::Patron->get_overdue prefetches
 373     my $overdue = $overdues->next->unblessed_all_relateds;
 374     is( $overdue->{issue_id}, $issue->issue_id, 'unblessed_all_relateds has field from the original table (issues)' );
 375     is( $overdue->{title}, $biblio->title, 'unblessed_all_relateds has field from other tables (biblio)' );
 376     is( $overdue->{homebranch}, $item->homebranch, 'unblessed_all_relateds has field from other tables (items)' );
 377
 378     $schema->storage->txn_rollback;
 379 };