3 # Copyright 2011 MJ Ray and software.coop
4 # This Koha test module is a stub!
5 # Add more tests here!!!
8 use Test::More tests => 10;
13 use t::lib::Mocks qw/mock_preference/; # to mock CronjobLog
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");
31 ok($success, "logaction seemed to work");
34 # FIXME: US formatted date hardcoded into test for now
35 $success = scalar(@{GetLogs("","","",undef,undef,"","")});
40 ok($success, "GetLogs returns results for an open search");
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, "", "") } );
50 ok($success, "GetLogs accepts dates in an All-matching search");
53 $success = scalar(@{GetLogs("","","",["MEMBERS"],["MODIFY"],1,"")});
58 ok($success, "GetLogs seemed to find ".$success." like our test record in a tighter search");
60 # Make sure we can rollback.
61 my $dbh = C4::Context->dbh;
62 $dbh->{AutoCommit} = 0;
63 $dbh->{RaiseError} = 1;
65 # We want numbers to be the same between runs.
66 $dbh->do("DELETE FROM action_logs;");
68 t::lib::Mocks::mock_preference('CronjobLog',0);
70 my $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
71 is($cronJobCount,0,"Cronjob not logged as expected.");
73 t::lib::Mocks::mock_preference('CronjobLog',1);
75 $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
76 is($cronJobCount,1,"Cronjob logged as expected.");
78 subtest "GetLogs should return all logs if dates are not set" => sub {
80 my $today = dt_from_string->add(minutes => -1);
81 my $yesterday = dt_from_string->add( days => -1 );
83 INSERT INTO action_logs (timestamp, user, module, action, object, info)
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' );
94 subtest 'logaction(): interface is correctly logged' => sub {
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)');
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");
110 is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly deduced (opac)');
112 # Explicit interfaces
113 $dbh->do("DELETE FROM action_logs;");
114 C4::Context->interface( 'intranet' );
115 logaction( "MEMBERS", "MODIFY", 1, 'test info', 'intranet');
117 is( @{$logs}[0]->{ interface }, 'intranet', 'Passed interface is respected (intranet)');
119 # Explicit interfaces
120 $dbh->do("DELETE FROM action_logs;");
121 C4::Context->interface( 'sip' );
122 logaction( "MEMBERS", "MODIFY", 1, 'test info', 'sip');
124 is( @{$logs}[0]->{ interface }, 'sip', 'Passed interface is respected (sip)');
129 subtest 'GetLogs() respects interface filters' => sub {
133 $dbh->do("DELETE FROM action_logs;");
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');
140 my $logs = scalar @{ GetLogs() };
141 is( $logs, 4, 'If no filter on interfaces is passed, all logs are returned');
143 $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['opac']);
144 is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly filtered (opac)');
146 $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['sip']);
147 is( @{$logs}[0]->{ interface }, 'sip', 'Interface correctly filtered (sip)');
149 $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['intranet']);
150 is( @{$logs}[0]->{ interface }, 'intranet', 'Interface correctly filtered (intranet)');
152 $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['commandline']);
153 is( @{$logs}[0]->{ interface }, 'commandline', 'Interface correctly filtered (commandline)');