koha-dev.rot13.org Git - srvgit/blob - t/db_dependent/Log.t

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