View | Details | Raw Unified | Return to bug 29321
Collapse All | Expand All

(-)a/C4/Log.pm (-14 / +27 lines)
Lines 21-29 package C4::Log; Link Here
21
# You should have received a copy of the GNU General Public License
21
# You should have received a copy of the GNU General Public License
22
# along with Koha; if not, see <http://www.gnu.org/licenses>.
22
# along with Koha; if not, see <http://www.gnu.org/licenses>.
23
23
24
use strict;
24
use Modern::Perl;
25
use warnings;
25
use Data::Dumper qw( Dumper );
26
27
use JSON qw( to_json );
26
use JSON qw( to_json );
28
27
29
use C4::Context;
28
use C4::Context;
Lines 43-49 C4::Log - Koha Log Facility functions Link Here
43
42
44
=head1 SYNOPSIS
43
=head1 SYNOPSIS
45
44
46
  use C4::Log;
45
use C4::Log;
47
46
48
=head1 DESCRIPTION
47
=head1 DESCRIPTION
49
48
Lines 51-61 The functions in this module perform various functions in order to log all the o Link Here
51
50
52
=head1 FUNCTIONS
51
=head1 FUNCTIONS
53
52
54
=over 2
53
=head2 logaction
55
56
=item logaction
57
54
58
  &logaction($modulename, $actionname, $objectnumber, $infos, $interface);
55
  &logaction($modulename, $actionname, $objectnumber, $info, $interface);
59
56
60
Adds a record into action_logs table to report the different changes upon the database.
57
Adds a record into action_logs table to report the different changes upon the database.
61
Each log entry includes the number of the user currently logged in.  For batch
58
Each log entry includes the number of the user currently logged in.  For batch
Lines 64-72 number is set to 0, which is the same as the superlibrarian's number. Link Here
64
61
65
=cut
62
=cut
66
63
67
#'
68
sub logaction {
64
sub logaction {
69
    my ($modulename, $actionname, $objectnumber, $infos, $interface)=@_;
65
    my ($modulename, $actionname, $objectnumber, $info, $interface)=@_;
70
66
71
    # Get ID of logged in user.  if called from a batch job,
67
    # Get ID of logged in user.  if called from a batch job,
72
    # no user session exists and C4::Context->userenv() returns
68
    # no user session exists and C4::Context->userenv() returns
Lines 76-84 sub logaction { Link Here
76
    $usernumber ||= 0;
72
    $usernumber ||= 0;
77
    $interface //= C4::Context->interface;
73
    $interface //= C4::Context->interface;
78
74
75
    $info = condense($info);
76
79
    my $dbh = C4::Context->dbh;
77
    my $dbh = C4::Context->dbh;
80
    my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info,interface) values (now(),?,?,?,?,?,?)");
78
    my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info,interface) values (now(),?,?,?,?,?,?)");
81
    $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$infos,$interface);
79
    $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$info,$interface);
82
    $sth->finish;
80
    $sth->finish;
83
81
84
    my $logger = Koha::Logger->get(
82
    my $logger = Koha::Logger->get(
Lines 95-108 sub logaction { Link Here
95
                    module => $modulename,
93
                    module => $modulename,
96
                    action => $actionname,
94
                    action => $actionname,
97
                    object => $objectnumber,
95
                    object => $objectnumber,
98
                    info   => $infos
96
                    info   => $info,
99
                }
97
                }
100
            );
98
            );
101
        }
99
        }
102
    );
100
    );
103
}
101
}
104
102
105
=item cronlogaction
103
=head2 condense
104
105
=cut
106
107
sub condense {
108
    my $info = shift;
109
    return $info unless C4::Context->preference('LogCondenseLimit');
110
111
    return $info if ref($info) eq q{} && length($info) <= C4::Context->preference('LogCondenseLimit');
112
113
    my $rv = $info;
114
    $rv = Dumper( $rv ) if ref($rv);
115
    $rv = substr( $rv, 0, C4::Context->preference('LogCondenseLimit') );
116
    return $rv;
117
}
118
119
=head2 cronlogaction
106
120
107
  &cronlogaction($infos);
121
  &cronlogaction($infos);
108
122
Lines 111-117 Logs the path and name of the calling script plus the information privided by pa Link Here
111
125
112
=cut
126
=cut
113
127
114
#'
115
sub cronlogaction {
128
sub cronlogaction {
116
    my ($infos)=@_;
129
    my ($infos)=@_;
117
    my $loginfo = (caller(0))[1];
130
    my $loginfo = (caller(0))[1];
(-)a/t/db_dependent/Log.t (-3 / +37 lines)
Lines 15-21 Link Here
15
# with Koha; if not, see <http://www.gnu.org/licenses>.
15
# with Koha; if not, see <http://www.gnu.org/licenses>.
16
16
17
use Modern::Perl;
17
use Modern::Perl;
18
use Test::More tests => 3;
18
use Test::More tests => 4;
19
use Data::Dumper qw( Dumper );
19
20
20
use C4::Context;
21
use C4::Context;
21
use C4::Log qw( logaction cronlogaction );
22
use C4::Log qw( logaction cronlogaction );
Lines 30-35 use t::lib::TestBuilder; Link Here
30
our $schema  = Koha::Database->new->schema;
31
our $schema  = Koha::Database->new->schema;
31
$schema->storage->txn_begin;
32
$schema->storage->txn_begin;
32
our $dbh = C4::Context->dbh;
33
our $dbh = C4::Context->dbh;
34
our $builder = t::lib::TestBuilder->new;
33
35
34
subtest 'Existing tests' => sub {
36
subtest 'Existing tests' => sub {
35
    plan tests => 3;
37
    plan tests => 3;
Lines 95-101 subtest 'logaction(): interface is correctly logged' => sub { Link Here
95
subtest 'GDPR logging' => sub {
97
subtest 'GDPR logging' => sub {
96
    plan tests => 6;
98
    plan tests => 6;
97
99
98
    my $builder = t::lib::TestBuilder->new;
99
    my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
100
    my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
100
101
101
    t::lib::Mocks::mock_userenv({ patron => $patron });
102
    t::lib::Mocks::mock_userenv({ patron => $patron });
Lines 150-153 subtest 'GDPR logging' => sub { Link Here
150
    is( $logs->count, 1, 'We expect only one auth success line for this patron' );
151
    is( $logs->count, 1, 'We expect only one auth success line for this patron' );
151
};
152
};
152
153
154
subtest 'Condense logging' => sub {
155
    plan tests => 4;
156
157
    # Log a patron object
158
    my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
159
    t::lib::Mocks::mock_preference('LogCondenseLimit', 2000 );
160
    logaction( "MEMBERS", "MODIFY", $patron->id, $patron, 'test1' );
161
    my $logs = Koha::ActionLogs->search({ object => $patron->id });
162
    my $rec = $logs->next;
163
    is( length($rec->info), 2000, 'First 2000 chars in log' );
164
165
    # Lower limit
166
    t::lib::Mocks::mock_preference('LogCondenseLimit', 1000 );
167
    logaction( "MEMBERS", "MODIFY", $patron->id, $patron, 'test2' );
168
    #$logs->reset;
169
    $rec = $logs->search({ interface => 'test2' })->next;
170
    is( length($rec->info), 1000, 'First 1000 chars found as expected' );
171
172
    # Log an unblessed hold
173
    t::lib::Mocks::mock_preference('LogCondenseLimit', 200 );
174
    my $hold_unblessed = $builder->build_object( { class => 'Koha::Holds' } )->unblessed;
175
    my $info = Dumper( $hold_unblessed );
176
    logaction( "HOLDS", "TEST", $hold_unblessed->{reserve_id}, $hold_unblessed, 'test3' );
177
    $logs = Koha::ActionLogs->search({ object => $hold_unblessed->{reserve_id}, interface => 'test3' });
178
    $rec = $logs->next;
179
    is( $rec->info, substr($info, 0, 200), 'Dump of unblessed hold found' );
180
    
181
    # Pass a too long string
182
    logaction( "HOLDS", "TEST", $hold_unblessed->{reserve_id}, $info, 'test4' );
183
    $logs = Koha::ActionLogs->search({ object => $hold_unblessed->{reserve_id}, interface => 'test4' });
184
    $rec = $logs->next;
185
    is( length($rec->info), 200, 'First 200 chars found as expected' );
186
};
187
153
$schema->storage->txn_rollback;
188
$schema->storage->txn_rollback;
154
- 

Return to bug 29321