t/db_dependent/Log.t

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