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