t/db_dependent/Members.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 => 47;
  21 use Test::MockModule;
  22 use Test::Exception;
  23
  24 use Data::Dumper qw/Dumper/;
  25 use C4::Context;
  26 use Koha::Database;
  27 use Koha::Holds;
  28 use Koha::List::Patron;
  29 use Koha::Patrons;
  30
  31 use t::lib::Mocks;
  32 use t::lib::TestBuilder;
  33
  34 BEGIN {
  35         use_ok('C4::Members');
  36 }
  37
  38 my $schema = Koha::Database->schema;
  39 $schema->storage->txn_begin;
  40 my $builder = t::lib::TestBuilder->new;
  41 my $dbh = C4::Context->dbh;
  42
  43 # Remove invalid guarantorid's as long as we have no FK
  44 $dbh->do("UPDATE borrowers b1 LEFT JOIN borrowers b2 ON b2.borrowernumber=b1.guarantorid SET b1.guarantorid=NULL where b1.guarantorid IS NOT NULL AND b2.borrowernumber IS NULL");
  45
  46 my $library1 = $builder->build({
  47     source => 'Branch',
  48 });
  49 my $library2 = $builder->build({
  50     source => 'Branch',
  51 });
  52 my $patron_category = $builder->build({ source => 'Category' });
  53 my $CARDNUMBER   = 'TESTCARD01';
  54 my $FIRSTNAME    = 'Marie';
  55 my $SURNAME      = 'Mcknight';
  56 my $BRANCHCODE   = $library1->{branchcode};
  57
  58 my $CHANGED_FIRSTNAME = "Marry Ann";
  59 my $EMAIL             = "Marie\@email.com";
  60 my $EMAILPRO          = "Marie\@work.com";
  61 my $PHONE             = "555-12123";
  62
  63 # XXX should be randomised and checked against the database
  64 my $IMPOSSIBLE_CARDNUMBER = "XYZZZ999";
  65
  66 t::lib::Mocks::mock_userenv();
  67
  68 # Make a borrower for testing
  69 my %data = (
  70     cardnumber => $CARDNUMBER,
  71     firstname =>  $FIRSTNAME . q{ },
  72     surname => $SURNAME,
  73     categorycode => $patron_category->{categorycode},
  74     branchcode => $BRANCHCODE,
  75     dateofbirth => '',
  76     dateexpiry => '9999-12-31',
  77     userid => 'tomasito'
  78 );
  79
  80 my $addmem=Koha::Patron->new(\%data)->store->borrowernumber;
  81 ok($addmem, "Koha::Patron->store()");
  82
  83 my $patron = Koha::Patrons->find( { cardnumber => $CARDNUMBER } )
  84   or BAIL_OUT("Cannot read member with card $CARDNUMBER");
  85 my $member = $patron->unblessed;
  86
  87 ok ( $member->{firstname}    eq $FIRSTNAME    &&
  88      $member->{surname}      eq $SURNAME      &&
  89      $member->{categorycode} eq $patron_category->{categorycode} &&
  90      $member->{branchcode}   eq $BRANCHCODE
  91      , "Got member")
  92   or diag("Mismatching member details: ".Dumper(\%data, $member));
  93
  94 is($member->{dateofbirth}, undef, "Empty dates handled correctly");
  95
  96 $member->{firstname} = $CHANGED_FIRSTNAME . q{ };
  97 $member->{email}     = $EMAIL;
  98 $member->{phone}     = $PHONE;
  99 $member->{emailpro}  = $EMAILPRO;
 100 $patron->set($member)->store;
 101 my $changedmember = Koha::Patrons->find( { cardnumber => $CARDNUMBER } )->unblessed;
 102 ok ( $changedmember->{firstname} eq $CHANGED_FIRSTNAME &&
 103      $changedmember->{email}     eq $EMAIL             &&
 104      $changedmember->{phone}     eq $PHONE             &&
 105      $changedmember->{emailpro}  eq $EMAILPRO
 106      , "Member Changed")
 107   or diag("Mismatching member details: ".Dumper($member, $changedmember));
 108
 109 t::lib::Mocks::mock_preference( 'CardnumberLength', '' );
 110 C4::Context->clear_syspref_cache();
 111
 112 my $checkcardnum=C4::Members::checkcardnumber($CARDNUMBER, "");
 113 is ($checkcardnum, "1", "Card No. in use");
 114
 115 $checkcardnum=C4::Members::checkcardnumber($IMPOSSIBLE_CARDNUMBER, "");
 116 is ($checkcardnum, "0", "Card No. not used");
 117
 118 t::lib::Mocks::mock_preference( 'CardnumberLength', '4' );
 119 C4::Context->clear_syspref_cache();
 120
 121 $checkcardnum=C4::Members::checkcardnumber($IMPOSSIBLE_CARDNUMBER, "");
 122 is ($checkcardnum, "2", "Card number is too long");
 123
 124
 125 # Add a new borrower
 126 %data = (
 127     cardnumber   => "123456789",
 128     firstname    => "Tomasito",
 129     surname      => "None",
 130     categorycode => $patron_category->{categorycode},
 131     branchcode   => $library2->{branchcode},
 132     dateofbirth  => '',
 133     debarred     => '',
 134     dateexpiry   => '',
 135     dateenrolled => '',
 136 );
 137 my $borrowernumber = Koha::Patron->new( \%data )->store->borrowernumber;
 138 $patron = Koha::Patrons->find( $borrowernumber );
 139 my $borrower = $patron->unblessed;
 140 is( $borrower->{dateofbirth}, undef, 'Koha::Patron->store should undef dateofbirth if empty string is given');
 141 is( $borrower->{debarred}, undef, 'Koha::Patron->store should undef debarred if empty string is given');
 142 isnt( $borrower->{dateexpiry}, '0000-00-00', 'Koha::Patron->store should not set dateexpiry to 0000-00-00 if empty string is given');
 143 isnt( $borrower->{dateenrolled}, '0000-00-00', 'Koha::Patron->store should not set dateenrolled to 0000-00-00 if empty string is given');
 144
 145 $patron->set({ dateofbirth => '', debarred => '', dateexpiry => '', dateenrolled => '' })->store;
 146 $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 147 is( $borrower->{dateofbirth}, undef, 'Koha::Patron->store should undef dateofbirth if empty string is given');
 148 is( $borrower->{debarred}, undef, 'Koha::Patron->store should undef debarred if empty string is given');
 149 isnt( $borrower->{dateexpiry}, '0000-00-00', 'Koha::Patron->store should not set dateexpiry to 0000-00-00 if empty string is given');
 150 isnt( $borrower->{dateenrolled}, '0000-00-00', 'Koha::Patron->store should not set dateenrolled to 0000-00-00 if empty string is given');
 151
 152 $patron->set({ dateofbirth => '1970-01-01', debarred => '2042-01-01', dateexpiry => '9999-12-31', dateenrolled => '2015-09-06' })->store;
 153 $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 154 is( $borrower->{dateofbirth}, '1970-01-01', 'Koha::Patron->store should correctly set dateofbirth if a valid date is given');
 155 is( $borrower->{debarred}, '2042-01-01', 'Koha::Patron->store should correctly set debarred if a valid date is given');
 156 is( $borrower->{dateexpiry}, '9999-12-31', 'Koha::Patron->store should correctly set dateexpiry if a valid date is given');
 157 is( $borrower->{dateenrolled}, '2015-09-06', 'Koha::Patron->store should correctly set dateenrolled if a valid date is given');
 158
 159 subtest 'Koha::Patron->store should not update userid if not true' => sub {
 160     plan tests => 3;
 161
 162     # TODO Move this to t/db_dependent/Koha/Patrons.t subtest ->store
 163
 164     $data{ cardnumber } = "234567890";
 165     $data{userid} = 'a_user_id';
 166     $borrowernumber = Koha::Patron->new( \%data )->store->borrowernumber;
 167     my $patron = Koha::Patrons->find( $borrowernumber );
 168     my $borrower = $patron->unblessed;
 169
 170     $patron->set( { firstname => 'Tomas', userid => '' } )->store;
 171     $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 172     is ( $borrower->{userid}, $data{userid}, 'Koha::Patron->store should not update the userid with an empty string' );
 173     $patron->set( { firstname => 'Tomas', userid => 0 } )->store;
 174     $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 175     is ( $borrower->{userid}, $data{userid}, 'Koha::Patron->store should not update the userid with an 0');
 176     $patron->set( { firstname => 'Tomas', userid => undef } )->store;
 177     $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 178     is ( $borrower->{userid}, $data{userid}, 'Koha::Patron->store should not update the userid with an undefined value');
 179 };
 180
 181 #Regression tests for bug 10612
 182 my $library3 = $builder->build({
 183     source => 'Branch',
 184 });
 185 $builder->build({
 186         source => 'Category',
 187         value => {
 188             categorycode         => 'STAFFER',
 189             description          => 'Staff dont batch del',
 190             category_type        => 'S',
 191         },
 192 });
 193
 194 $builder->build({
 195         source => 'Category',
 196         value => {
 197             categorycode         => 'CIVILIAN',
 198             description          => 'Civilian batch del',
 199             category_type        => 'A',
 200         },
 201 });
 202
 203 $builder->build({
 204         source => 'Category',
 205         value => {
 206             categorycode         => 'KIDclamp',
 207             description          => 'Kid to be guaranteed',
 208             category_type        => 'C',
 209         },
 210 });
 211
 212 my $borrower1 = $builder->build({
 213         source => 'Borrower',
 214         value  => {
 215             categorycode=>'STAFFER',
 216             branchcode => $library3->{branchcode},
 217             dateexpiry => '2015-01-01',
 218             guarantorid=> undef,
 219         },
 220 });
 221 my $bor1inlist = $borrower1->{borrowernumber};
 222 my $borrower2 = $builder->build({
 223         source => 'Borrower',
 224         value  => {
 225             categorycode=>'STAFFER',
 226             branchcode => $library3->{branchcode},
 227             dateexpiry => '2015-01-01',
 228             guarantorid=> undef,
 229         },
 230 });
 231
 232 my $guarantee = $builder->build({
 233         source => 'Borrower',
 234         value  => {
 235             categorycode=>'KIDclamp',
 236             branchcode => $library3->{branchcode},
 237             dateexpiry => '2015-01-01',
 238             guarantorid=> undef, # will be filled later
 239         },
 240 });
 241
 242 my $bor2inlist = $borrower2->{borrowernumber};
 243
 244 $builder->build({
 245         source => 'OldIssue',
 246         value  => {
 247             borrowernumber => $bor2inlist,
 248             timestamp => '2016-01-01',
 249         },
 250 });
 251
 252 # The following calls to GetBorrowersToExpunge are assuming that the pref
 253 # IndependentBranches is off.
 254 t::lib::Mocks::mock_preference('IndependentBranches', 0);
 255
 256 my $owner = Koha::Patron->new({ categorycode => 'STAFFER', branchcode => $library2->{branchcode} })->store->borrowernumber;
 257 my $list1 = AddPatronList( { name => 'Test List 1', owner => $owner } );
 258 my @listpatrons = ($bor1inlist, $bor2inlist);
 259 AddPatronsToList(  { list => $list1, borrowernumbers => \@listpatrons });
 260 my $patstodel = GetBorrowersToExpunge( {patron_list_id => $list1->patron_list_id() } );
 261 is( scalar(@$patstodel),0,'No staff deleted from list of all staff');
 262 Koha::Patrons->find($bor2inlist)->set({ categorycode => 'CIVILIAN' })->store;
 263 $patstodel = GetBorrowersToExpunge( {patron_list_id => $list1->patron_list_id()} );
 264 ok( scalar(@$patstodel)== 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Staff patron not deleted from list');
 265 $patstodel = GetBorrowersToExpunge( {branchcode => $library3->{branchcode},patron_list_id => $list1->patron_list_id() } );
 266 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Staff patron not deleted by branchcode and list');
 267 $patstodel = GetBorrowersToExpunge( {expired_before => '2015-01-02', patron_list_id => $list1->patron_list_id() } );
 268 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Staff patron not deleted by expirationdate and list');
 269 $patstodel = GetBorrowersToExpunge( {not_borrowed_since => '2016-01-02', patron_list_id => $list1->patron_list_id() } );
 270 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Staff patron not deleted by last issue date');
 271
 272 Koha::Patrons->find($bor1inlist)->set({ categorycode => 'CIVILIAN' })->store;
 273 Koha::Patrons->find($guarantee->{borrowernumber})->set({ guarantorid => $bor1inlist })->store;
 274
 275 $patstodel = GetBorrowersToExpunge( {patron_list_id => $list1->patron_list_id()} );
 276 ok( scalar(@$patstodel)== 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Guarantor patron not deleted from list');
 277 $patstodel = GetBorrowersToExpunge( {branchcode => $library3->{branchcode},patron_list_id => $list1->patron_list_id() } );
 278 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Guarantor patron not deleted by branchcode and list');
 279 $patstodel = GetBorrowersToExpunge( {expired_before => '2015-01-02', patron_list_id => $list1->patron_list_id() } );
 280 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Guarantor patron not deleted by expirationdate and list');
 281 $patstodel = GetBorrowersToExpunge( {not_borrowed_since => '2016-01-02', patron_list_id => $list1->patron_list_id() } );
 282 ok( scalar(@$patstodel) == 1 && $patstodel->[0]->{'borrowernumber'} eq $bor2inlist,'Guarantor patron not deleted by last issue date');
 283 Koha::Patrons->find($guarantee->{borrowernumber})->set({ guarantorid => undef })->store;
 284
 285 $builder->build({
 286         source => 'Issue',
 287         value  => {
 288             borrowernumber => $bor2inlist,
 289         },
 290 });
 291 $patstodel = GetBorrowersToExpunge( {patron_list_id => $list1->patron_list_id()} );
 292 is( scalar(@$patstodel),1,'Borrower with issue not deleted from list');
 293 $patstodel = GetBorrowersToExpunge( {branchcode => $library3->{branchcode},patron_list_id => $list1->patron_list_id() } );
 294 is( scalar(@$patstodel),1,'Borrower with issue not deleted by branchcode and list');
 295 $patstodel = GetBorrowersToExpunge( {category_code => 'CIVILIAN',patron_list_id => $list1->patron_list_id() } );
 296 is( scalar(@$patstodel),1,'Borrower with issue not deleted by category_code and list');
 297 $patstodel = GetBorrowersToExpunge( {expired_before => '2015-01-02',patron_list_id => $list1->patron_list_id() } );
 298 is( scalar(@$patstodel),1,'Borrower with issue not deleted by expiration_date and list');
 299 $builder->schema->resultset( 'Issue' )->delete_all;
 300 $patstodel = GetBorrowersToExpunge( {patron_list_id => $list1->patron_list_id()} );
 301 ok( scalar(@$patstodel)== 2,'Borrowers without issue deleted from list');
 302 $patstodel = GetBorrowersToExpunge( {category_code => 'CIVILIAN',patron_list_id => $list1->patron_list_id() } );
 303 is( scalar(@$patstodel),2,'Borrowers without issues deleted by category_code and list');
 304 $patstodel = GetBorrowersToExpunge( {expired_before => '2015-01-02',patron_list_id => $list1->patron_list_id() } );
 305 is( scalar(@$patstodel),2,'Borrowers without issues deleted by expiration_date and list');
 306 $patstodel = GetBorrowersToExpunge( {not_borrowed_since => '2016-01-02', patron_list_id => $list1->patron_list_id() } );
 307 is( scalar(@$patstodel),2,'Borrowers without issues deleted by last issue date');
 308
 309 # Test GetBorrowersToExpunge and TrackLastPatronActivity
 310 $dbh->do(q|UPDATE borrowers SET lastseen=NULL|);
 311 $builder->build({ source => 'Borrower', value => { lastseen => '2016-01-01 01:01:01', categorycode => 'CIVILIAN', guarantorid => undef } } );
 312 $builder->build({ source => 'Borrower', value => { lastseen => '2016-02-02 02:02:02', categorycode => 'CIVILIAN', guarantorid => undef } } );
 313 $builder->build({ source => 'Borrower', value => { lastseen => '2016-03-03 03:03:03', categorycode => 'CIVILIAN', guarantorid => undef } } );
 314 $patstodel = GetBorrowersToExpunge( { last_seen => '1999-12-12' });
 315 is( scalar @$patstodel, 0, 'TrackLastPatronActivity - 0 patrons must be deleted' );
 316 $patstodel = GetBorrowersToExpunge( { last_seen => '2016-02-15' });
 317 is( scalar @$patstodel, 2, 'TrackLastPatronActivity - 2 patrons must be deleted' );
 318 $patstodel = GetBorrowersToExpunge( { last_seen => '2016-04-04' });
 319 is( scalar @$patstodel, 3, 'TrackLastPatronActivity - 3 patrons must be deleted' );
 320 my $patron2 = $builder->build({ source => 'Borrower', value => { lastseen => undef } });
 321 t::lib::Mocks::mock_preference( 'TrackLastPatronActivity', '0' );
 322 Koha::Patrons->find( $patron2->{borrowernumber} )->track_login;
 323 is( Koha::Patrons->find( $patron2->{borrowernumber} )->lastseen, undef, 'Lastseen should not be changed' );
 324 Koha::Patrons->find( $patron2->{borrowernumber} )->track_login({ force => 1 });
 325 isnt( Koha::Patrons->find( $patron2->{borrowernumber} )->lastseen, undef, 'Lastseen should be changed now' );
 326
 327 # Regression tests for BZ13502
 328 ## Remove all entries with userid='' (should be only 1 max)
 329 $dbh->do(q|DELETE FROM borrowers WHERE userid = ''|);
 330 ## And create a patron with a userid=''
 331 $borrowernumber = Koha::Patron->new({ categorycode => $patron_category->{categorycode}, branchcode => $library2->{branchcode} })->store->borrowernumber;
 332 $dbh->do(q|UPDATE borrowers SET userid = '' WHERE borrowernumber = ?|, undef, $borrowernumber);
 333 # Create another patron and verify the userid has been generated
 334 $borrowernumber = Koha::Patron->new({ categorycode => $patron_category->{categorycode}, branchcode => $library2->{branchcode} })->store->borrowernumber;
 335 ok( $borrowernumber > 0, 'Koha::Patron->store should have inserted the patron even if no userid is given' );
 336 $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 337 ok( $borrower->{userid},  'A userid should have been generated correctly' );
 338
 339 subtest 'purgeSelfRegistration' => sub {
 340     plan tests => 5;
 341
 342     #purge unverified
 343     my $d=360;
 344     C4::Members::DeleteUnverifiedOpacRegistrations($d);
 345     foreach(1..3) {
 346         $dbh->do("INSERT INTO borrower_modifications (timestamp, borrowernumber, verification_token) VALUES ('2014-01-01 01:02:03',0,?)", undef, (scalar localtime)."_$_");
 347     }
 348     is( C4::Members::DeleteUnverifiedOpacRegistrations($d), 3, 'Test for DeleteUnverifiedOpacRegistrations' );
 349
 350     #purge members in temporary category
 351     my $c= 'XYZ';
 352     $dbh->do("INSERT IGNORE INTO categories (categorycode) VALUES ('$c')");
 353     t::lib::Mocks::mock_preference('PatronSelfRegistrationDefaultCategory', $c );
 354     t::lib::Mocks::mock_preference('PatronSelfRegistrationExpireTemporaryAccountsDelay', 360);
 355     C4::Members::DeleteExpiredOpacRegistrations();
 356     my $self_reg = $builder->build_object({
 357         class => 'Koha::Patrons',
 358         value => {
 359             dateenrolled => '2014-01-01 01:02:03',
 360             categorycode => $c
 361         }
 362     });
 363
 364     my $checkout     = $builder->build_object({
 365         class=>'Koha::Checkouts',
 366         value=>{
 367             borrowernumber=>$self_reg->borrowernumber
 368         }
 369     });
 370     is( C4::Members::DeleteExpiredOpacRegistrations(), 0, "DeleteExpiredOpacRegistrations doesn't delete borrower with checkout");
 371
 372     my $account_line = $builder->build_object({
 373         class=>'Koha::Account::Lines',
 374         value=>{
 375             borrowernumber=>$self_reg->borrowernumber,
 376             amountoutstanding=>5
 377         }
 378     });
 379     is( C4::Members::DeleteExpiredOpacRegistrations(), 0, "DeleteExpiredOpacRegistrations doesn't delete borrower with checkout and fine");
 380
 381     $checkout->delete;
 382     is( C4::Members::DeleteExpiredOpacRegistrations(), 0, "DeleteExpiredOpacRegistrations doesn't delete borrower with fine and no checkout");
 383
 384     $account_line->delete;
 385     is( C4::Members::DeleteExpiredOpacRegistrations(), 1, "DeleteExpiredOpacRegistrations does delete borrower with no fines and no checkouts");
 386
 387 };
 388
 389 sub _find_member {
 390     my ($resultset) = @_;
 391     my $found = $resultset && grep( { $_->{cardnumber} && $_->{cardnumber} eq $CARDNUMBER } @$resultset );
 392     return $found;
 393 }
 394
 395 $schema->storage->txn_rollback;
 396
 397 subtest 'Koha::Patron->store (invalid categorycode) tests' => sub {
 398     plan tests => 1;
 399     # TODO Move this to t/db_dependent/Koha/Patrons.t subtest ->store
 400
 401     $schema->storage->txn_begin;
 402
 403     my $category    = $builder->build_object({ class => 'Koha::Patron::Categories' });
 404     my $category_id = $category->id;
 405     # Remove category to make sure the id is not on the DB
 406     $category->delete;
 407
 408     my $patron_data = {
 409         categorycode => $category_id
 410     };
 411
 412     throws_ok
 413         { Koha::Patron->new( $patron_data )->store; }
 414         'Koha::Exceptions::Object::FKConstraint',
 415         'AddMember raises an exception on invalid categorycode';
 416
 417     $schema->storage->txn_rollback;
 418 };