Koha/t/db_dependent/Patron/Borrower_Debarments.t

#!/usr/bin/perl

use Modern::Perl;

use C4::Context;

use Koha::Database;
use Koha::DateUtils qw(dt_from_string);
use Koha::Patrons;
use Koha::Account;
use Koha::ActionLogs;

use t::lib::Mocks;
use t::lib::TestBuilder;

use Test::More tests => 39;

use_ok('Koha::Patron::Debarments');

my $schema = Koha::Database->schema;
$schema->storage->txn_begin;
my $builder = t::lib::TestBuilder->new;
my $dbh = C4::Context->dbh;

my $library = $builder->build({
    source => 'Branch',
});

my $patron_category = $builder->build({ source => 'Category' });
my $patron = $builder->build_object(
    {
        class  => 'Koha::Patrons',
        value => {
            firstname    => 'my firstname',
            surname      => 'my surname',
            categorycode => $patron_category->{categorycode},
            branchcode   => $library->{branchcode},
        }
    }
);
my $borrowernumber = $patron->borrowernumber;

my $success = Koha::Patron::Debarments::AddDebarment({
    borrowernumber => $borrowernumber,
    expiration => '9999-06-10',
    type => 'MANUAL',
    comment => 'Test 1',
});
is( $success, 1, "AddDebarment returned true" );


my $restrictions = $patron->restrictions;
my $THE_restriction = $restrictions->next;
is( $restrictions->count, 1, '$patron->restrictions returns 1 restriction' );
is( $THE_restriction->type->code, 'MANUAL', "Correctly stored 'type'" );
is( $THE_restriction->expiration, '9999-06-10', "Correctly stored 'expiration'" );
is( $THE_restriction->comment, 'Test 1', "Correctly stored 'comment'" );


$success = Koha::Patron::Debarments::AddDebarment({
    borrowernumber => $borrowernumber,
    comment => 'Test 2',
});

$restrictions = $patron->restrictions;
$THE_restriction = $restrictions->last;
is( $restrictions->count, 2, '$patron->restrictions returns 2 restrictions' );
is( $THE_restriction->type->code, 'MANUAL', "Correctly stored 'type'" );
is( $THE_restriction->expiration, undef, "Correctly stored debarrment with no expiration" );
is( $THE_restriction->comment, 'Test 2', "Correctly stored 'comment'" );


Koha::Patron::Debarments::ModDebarment({
    borrower_debarment_id => $THE_restriction->borrower_debarment_id,
    comment => 'Test 3',
    expiration => '9998-06-10',
});

$restrictions = $patron->restrictions;
$THE_restriction = $restrictions->last;
is( $restrictions->count, 2, '$patron->restrictions returns 2 restrictions' );
is( $THE_restriction->comment, 'Test 3', "ModDebarment functions correctly" );

$patron = $patron->get_from_storage;
is( $patron->debarred, '9999-06-10', "Field borrowers.debarred set correctly" );
is( $patron->debarredcomment, "Test 1\nTest 3", "Field borrowers.debarredcomment set correctly" );


Koha::Patron::Debarments::AddUniqueDebarment({
    borrowernumber => $borrowernumber,
    type           => 'OVERDUES'
});

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
$THE_restriction = $restrictions->next;
is( $restrictions->count, 1, '$patron->restrictions->search({ type => "OVERDUES" }) returns 1 OVERDUES restriction after running AddUniqueDebarment once' );
is( $THE_restriction->type->code, 'OVERDUES', "AddOverduesDebarment created new debarment correctly" );

Koha::Patron::Debarments::AddUniqueDebarment({
    borrowernumber => $borrowernumber,
    expiration => '9999-11-09',
    type => 'OVERDUES'
});

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
$THE_restriction = $restrictions->next;
is( $restrictions->count, 1, '$patron->restrictions->search({ type => "OVERDUES" }) returns 1 OVERDUES restriction after running AddUniqueDebarent twice' );
is( $THE_restriction->expiration, '9999-11-09', "AddUniqueDebarment updated the OVERDUES restriction correctly" );


my $delUniqueDebarment = Koha::Patron::Debarments::DelUniqueDebarment({
});
is( $delUniqueDebarment, undef, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' returns undef" );

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
is( $restrictions->count, 1, "DelUniqueDebarment without the arguments 'borrowernumber' and 'type' does not delete the debarment" );

$delUniqueDebarment = Koha::Patron::Debarments::DelUniqueDebarment({
    borrowernumber => $borrowernumber,
});
is( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'type' returns undef" );

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
is( $restrictions->count, 1, "DelUniqueDebarment without the argument 'type' does not delete the debarment" );

$delUniqueDebarment = Koha::Patron::Debarments::DelUniqueDebarment({
    type => 'OVERDUES'
});
is( $delUniqueDebarment, undef, "DelUniqueDebarment without the argument 'borrowernumber' returns undef" );

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
is( $restrictions->count, 1, "DelUniqueDebarment without the argument 'borrowerumber' does not delete the debarment" );

$delUniqueDebarment = Koha::Patron::Debarments::DelUniqueDebarment({
    borrowernumber => $borrowernumber,
    type => 'SUSPENSION',
});
is( $delUniqueDebarment, undef, "DelUniqueDebarment with wrong arguments returns undef" );

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
is( $restrictions->count, 1, "DelUniqueDebarment with wrong arguments does not delete the debarment" );

$delUniqueDebarment = Koha::Patron::Debarments::DelUniqueDebarment({
    borrowernumber => $borrowernumber,
    type => 'OVERDUES',
});
is( $delUniqueDebarment, 1, "DelUniqueDebarment returns 1" );

$restrictions = $patron->restrictions->search(
    {
        type => 'OVERDUES',
    }
);
is( $restrictions->count, 0, "DelUniqueDebarment functions correctly" );

$restrictions = $patron->restrictions;
while ( my $restriction = $restrictions->next ) {
    Koha::Patron::Debarments::DelDebarment( $restriction->borrower_debarment_id );
}

$restrictions = $patron->restrictions;
is( $restrictions->count, 0, "DelDebarment functions correctly" );

$dbh->do(q|UPDATE borrowers SET debarred = '1970-01-01'|);
is( Koha::Patrons->find( $borrowernumber )->is_debarred, undef, 'A patron with a debarred date in the past is not debarred' );

$dbh->do(q|UPDATE borrowers SET debarred = NULL|);
is( Koha::Patrons->find( $borrowernumber )->is_debarred, undef, 'A patron without a debarred date is not debarred' );

$dbh->do(q|UPDATE borrowers SET debarred = '9999-12-31'|); # Note: Change this test before the first of January 10000!
is( Koha::Patrons->find( $borrowernumber )->is_debarred, '9999-12-31', 'A patron with a debarred date in the future is debarred' );

# Test patrons merge
my $borrowernumber2 = Koha::Patron->new(
    {
        firstname    => 'my firstname bis',
        surname      => 'my surname bis',
        categorycode => $patron_category->{categorycode},
        branchcode   => $library->{branchcode},
    }
)->store->borrowernumber;
my $debarreddate2    = '9999-06-10'; # Be sure to be in the future
my $debarredcomment2 = 'Test merge';
Koha::Patron::Debarments::AddDebarment(
    {
        borrowernumber => $borrowernumber2,
        expiration     => $debarreddate2,
        type           => 'MANUAL',
        comment        => $debarredcomment2,
    }
);
my $borrowernumber3 = Koha::Patron->new(
    {
        firstname    => 'my firstname ter',
        surname      => 'my surname ter',
        categorycode => $patron_category->{categorycode},
        branchcode   => $library->{branchcode},
    }
)->store->borrowernumber;
Koha::Patrons->find($borrowernumber3)->merge_with( [$borrowernumber2] );
is( Koha::Patrons->find($borrowernumber3)->debarred,
    $debarreddate2, 'Koha::Patron->merge_with() transfers well debarred' );
is( Koha::Patrons->find($borrowernumber3)->debarredcomment,
    $debarredcomment2, 'Koha::Patron->merge_with() transfers well debarredcomment' );

# Test removing debartments after payment
$builder->build(
    {
        source => 'RestrictionType',
        value  => {
            code               => 'TEST',
            display_text       => 'This is a test.',
            is_system          => 0,
            is_default         => 0,
            lift_after_payment => 1,
            fee_limit          => 5
        }
    }
);

$builder->build(
    {
        source => 'RestrictionType',
        value  => {
            code               => 'TEST2',
            display_text       => 'This too is a test.',
            is_system          => 0,
            is_default         => 0,
            lift_after_payment => 1,
            fee_limit          => 0
        }
    }
);

my $patron4 = Koha::Patron->new(
    {
        firstname    => 'First',
        surname      => 'Sur',
        categorycode => $patron_category->{categorycode},
        branchcode   => $library->{branchcode},
    }
)->store;

my $account = $patron4->account;
my $line1   = $account->add_debit( { type => 'ACCOUNT', amount => 10, interface => 'commandline' } );

Koha::Patron::Debarments::AddDebarment(
    {
        borrowernumber => $patron4->borrowernumber,
        expiration     => '9999-06-10',
        type           => 'TEST',
        comment        => 'Test delete'
    }
);

Koha::Patron::Debarments::AddDebarment(
    {
        borrowernumber => $patron4->borrowernumber,
        expiration     => '9999-10-10',
        type           => 'TEST2',
        comment        => 'Test delete again',
    }
);

$restrictions = $patron4->restrictions;

is( $restrictions->count, 2, "->restrictions returns 2 restrictions before payment" );

$account->pay( { amount => 5 } );
$restrictions = $patron4->restrictions;
is( $restrictions->count,            1,       "->restrictions returns 1 restriction after paying half of the fee" );
is( $restrictions->next->type->code, "TEST2", "Restriction left has type value 'TEST2'" );

$account->pay( { amount => 5 } );
$restrictions = $patron4->restrictions;
is( $restrictions->count, 0, "->restrictions returns 0 restrictions after paying all fees" );

$schema->storage->txn_rollback;

subtest 'BorrowersLog tests' => sub {

    plan tests => 16;

    $schema->storage->txn_begin;

    my $patron = $builder->build_object(
        {
            class => 'Koha::Patrons',
            value => { debarred => undef, debarredcomment => undef, }
        }
    );

    my $type = $builder->build_object( { class => 'Koha::Patron::Restriction::Types' } );

    foreach my $type (qw{CREATE_RESTRICTION MODIFY_RESTRICTION DELETE_RESTRICTION}) {
        is(
            Koha::ActionLogs->search( { module => 'MEMBERS', action => $type, object => $patron->id } )->count, 0,
            "No prior '$type' logs"
        );
    }

    t::lib::Mocks::mock_preference( 'BorrowersLog', 0 );

    my $add_comment    = 'AddDebarment comment';
    my $add_expiration = dt_from_string()->add( days => 1 );

    Koha::Patron::Debarments::AddDebarment(
        {
            borrowernumber => $patron->id,
            expiration     => $add_expiration,
            type           => $type->code,
            comment        => $add_comment,
        }
    );

    my $restrictions = $patron->restrictions;
    is( $restrictions->count, 1, 'Only one restriction present' );

    my $restriction = $restrictions->next;

    my $mod_comment    = 'ModDebarment comment';
    my $mod_expiration = dt_from_string()->add( days => 5 );

    Koha::Patron::Debarments::ModDebarment(
        {
            borrower_debarment_id => $restriction->id,
            comment               => $mod_comment,
            expiration            => $mod_expiration,
        }
    );

    Koha::Patron::Debarments::DelDebarment( $restriction->id );

    is( $patron->restrictions->count, 0, 'No restrictions present' );

    foreach my $type (qw{CREATE_RESTRICTION MODIFY_RESTRICTION DELETE_RESTRICTION}) {
        is(
            Koha::ActionLogs->search( { module => 'MEMBERS', action => $type, object => $patron->id } )->count, 0,
            "No added '$type' logs"
        );
    }

    t::lib::Mocks::mock_preference( 'BorrowersLog', 1 );

    Koha::Patron::Debarments::AddDebarment(
        {
            borrowernumber => $patron->id,
            expiration     => $add_expiration,
            type           => $type->code,
            comment        => $add_comment,
        }
    );

    $restrictions = $patron->restrictions;
    is( $restrictions->count, 1, 'Only one restriction present' );

    $restriction = $restrictions->next;

    Koha::Patron::Debarments::ModDebarment(
        {
            borrower_debarment_id => $restriction->id,
            comment               => $mod_comment,
            expiration            => $mod_expiration,
        }
    );

    Koha::Patron::Debarments::DelDebarment( $restriction->id );

    is( $patron->restrictions->count, 0, 'No restrictions present' );

    my $add_logs =
        Koha::ActionLogs->search( { module => 'MEMBERS', action => 'CREATE_RESTRICTION', object => $patron->id } );
    my $mod_logs =
        Koha::ActionLogs->search( { module => 'MEMBERS', action => 'MODIFY_RESTRICTION', object => $patron->id } );
    my $del_logs =
        Koha::ActionLogs->search( { module => 'MEMBERS', action => 'DELETE_RESTRICTION', object => $patron->id } );

    is( $add_logs->count, 1, 'Restriction creation logged' );
    like( $add_logs->next->info, qr/$add_comment/ );

    is( $mod_logs->count, 1, 'Restriction modification logged' );
    like( $mod_logs->next->info, qr/$mod_comment/ );

    is( $del_logs->count, 1, 'Restriction deletion logged' );
    like( $del_logs->next->info, qr/$mod_comment/, 'Deleted restriction contains last known comment' );

    $schema->storage->txn_rollback;
};