t/db_dependent/Log.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 under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, see <http://www.gnu.org/licenses>.
  16
  17 use Modern::Perl;
  18 use Test::More tests => 5;
  19
  20 use C4::Context;
  21 use C4::Log;
  22 use Koha::Database;
  23 use Koha::DateUtils;
  24
  25 use t::lib::Mocks qw/mock_preference/; # to mock CronjobLog
  26 use t::lib::TestBuilder;
  27
  28 # Make sure we can rollback.
  29 our $schema  = Koha::Database->new->schema;
  30 $schema->storage->txn_begin;
  31 our $dbh = C4::Context->dbh;
  32
  33 subtest 'Existing tests' => sub {
  34     plan tests => 6;
  35
  36     my $success;
  37     eval {
  38         # FIXME: are we sure there is an member number 1?
  39         logaction("MEMBERS","MODIFY",1,"test operation");
  40         $success = 1;
  41     } or do {
  42         diag($@);
  43         $success = 0;
  44     };
  45     ok($success, "logaction seemed to work");
  46
  47     eval {
  48         # FIXME: US formatted date hardcoded into test for now
  49         $success = scalar(@{GetLogs("","","",undef,undef,"","")});
  50     } or do {
  51         diag($@);
  52         $success = 0;
  53     };
  54     ok($success, "GetLogs returns results for an open search");
  55
  56     eval {
  57         # FIXME: US formatted date hardcoded into test for now
  58         my $date = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
  59         $success = scalar(@{GetLogs( $date, $date, "", undef, undef, "", "") } );
  60     } or do {
  61         diag($@);
  62         $success = 0;
  63     };
  64     ok($success, "GetLogs accepts dates in an All-matching search");
  65
  66     eval {
  67         $success = scalar(@{GetLogs("","","",["MEMBERS"],["MODIFY"],1,"")});
  68     } or do {
  69         diag($@);
  70         $success = 0;
  71     };
  72     ok($success, "GetLogs seemed to find ".$success." like our test record in a tighter search");
  73
  74     # We want numbers to be the same between runs.
  75     $dbh->do("DELETE FROM action_logs;");
  76
  77     t::lib::Mocks::mock_preference('CronjobLog',0);
  78     cronlogaction();
  79     my $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
  80     is($cronJobCount,0,"Cronjob not logged as expected.");
  81
  82     t::lib::Mocks::mock_preference('CronjobLog',1);
  83     cronlogaction();
  84     $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
  85     is($cronJobCount,1,"Cronjob logged as expected.");
  86 };
  87
  88 subtest "GetLogs should return all logs if dates are not set" => sub {
  89     plan tests => 2;
  90     my $today = dt_from_string->add(minutes => -1);
  91     my $yesterday = dt_from_string->add( days => -1 );
  92     $dbh->do(q|
  93         INSERT INTO action_logs (timestamp, user, module, action, object, info)
  94         VALUES
  95         (?, 42, 'CATALOGUING', 'MODIFY', 4242, 'Record 42 has been modified by patron 4242 yesterday'),
  96         (?, 43, 'CATALOGUING', 'MODIFY', 4242, 'Record 43 has been modified by patron 4242 today')
  97     |, undef, output_pref({dt =>$yesterday, dateformat => 'iso'}), output_pref({dt => $today, dateformat => 'iso'}));
  98     my $logs = GetLogs( undef, undef, undef, ['CATALOGUING'], ['MODIFY'], 4242 );
  99     is( scalar(@$logs), 2, 'GetLogs should return all logs regardless the dates' );
 100     $logs = GetLogs( output_pref($today), undef, undef, ['CATALOGUING'], ['MODIFY'], 4242 );
 101     is( scalar(@$logs), 1, 'GetLogs should return the logs for today' );
 102 };
 103
 104 subtest 'logaction(): interface is correctly logged' => sub {
 105
 106     plan tests => 4;
 107
 108     # No interface passed, using C4::Context->interface
 109     $dbh->do("DELETE FROM action_logs;");
 110     C4::Context->interface( 'commandline' );
 111     logaction( "MEMBERS", "MODIFY", 1, "test operation");
 112     my $logs = GetLogs();
 113     is( @{$logs}[0]->{ interface }, 'commandline', 'Interface correctly deduced (commandline)');
 114
 115     # No interface passed, using C4::Context->interface
 116     $dbh->do("DELETE FROM action_logs;");
 117     C4::Context->interface( 'opac' );
 118     logaction( "MEMBERS", "MODIFY", 1, "test operation");
 119     $logs = GetLogs();
 120     is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly deduced (opac)');
 121
 122     # Explicit interfaces
 123     $dbh->do("DELETE FROM action_logs;");
 124     C4::Context->interface( 'intranet' );
 125     logaction( "MEMBERS", "MODIFY", 1, 'test info', 'intranet');
 126     $logs = GetLogs();
 127     is( @{$logs}[0]->{ interface }, 'intranet', 'Passed interface is respected (intranet)');
 128
 129     # Explicit interfaces
 130     $dbh->do("DELETE FROM action_logs;");
 131     C4::Context->interface( 'sip' );
 132     logaction( "MEMBERS", "MODIFY", 1, 'test info', 'sip');
 133     $logs = GetLogs();
 134     is( @{$logs}[0]->{ interface }, 'sip', 'Passed interface is respected (sip)');
 135 };
 136
 137 subtest 'GetLogs() respects interface filters' => sub {
 138
 139     plan tests => 5;
 140
 141     $dbh->do("DELETE FROM action_logs;");
 142
 143     logaction( 'MEMBERS', 'MODIFY', 1, 'opac info',        'opac');
 144     logaction( 'MEMBERS', 'MODIFY', 1, 'sip info',         'sip');
 145     logaction( 'MEMBERS', 'MODIFY', 1, 'intranet info',    'intranet');
 146     logaction( 'MEMBERS', 'MODIFY', 1, 'commandline info', 'commandline');
 147
 148     my $logs = scalar @{ GetLogs() };
 149     is( $logs, 4, 'If no filter on interfaces is passed, all logs are returned');
 150
 151     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['opac']);
 152     is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly filtered (opac)');
 153
 154     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['sip']);
 155     is( @{$logs}[0]->{ interface }, 'sip', 'Interface correctly filtered (sip)');
 156
 157     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['intranet']);
 158     is( @{$logs}[0]->{ interface }, 'intranet', 'Interface correctly filtered (intranet)');
 159
 160     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['commandline']);
 161     is( @{$logs}[0]->{ interface }, 'commandline', 'Interface correctly filtered (commandline)');
 162 };
 163
 164 subtest 'GDPR logging' => sub {
 165     plan tests => 1;
 166
 167     my $builder = t::lib::TestBuilder->new;
 168     my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
 169
 170     t::lib::Mocks::mock_userenv({ patron => $patron });
 171     logaction( 'AUTH', 'FAILURE', $patron->id, '', 'opac' );
 172     my $logs = GetLogs( undef, undef, $patron->id, ['AUTH'], ['FAILURE'], $patron->id );
 173     is( @$logs, 1, 'We should find one auth failure for this patron' );
 174
 175 };
 176
 177 $schema->storage->txn_rollback;