@@ -, +, @@ --- C4/Log.pm | 41 +++++++++++++++++++++++++++-------------- t/db_dependent/Log.t | 39 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 64 insertions(+), 16 deletions(-) --- a/C4/Log.pm +++ a/C4/Log.pm @@ -21,9 +21,8 @@ package C4::Log; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -use strict; -use warnings; - +use Modern::Perl; +use Data::Dumper qw( Dumper ); use JSON qw( to_json ); use C4::Context; @@ -43,7 +42,7 @@ C4::Log - Koha Log Facility functions =head1 SYNOPSIS - use C4::Log; +use C4::Log; =head1 DESCRIPTION @@ -51,11 +50,9 @@ The functions in this module perform various functions in order to log all the o =head1 FUNCTIONS -=over 2 - -=item logaction +=head2 logaction - &logaction($modulename, $actionname, $objectnumber, $infos, $interface); + &logaction($modulename, $actionname, $objectnumber, $info, $interface); Adds a record into action_logs table to report the different changes upon the database. Each log entry includes the number of the user currently logged in. For batch @@ -64,9 +61,8 @@ number is set to 0, which is the same as the superlibrarian's number. =cut -#' sub logaction { - my ($modulename, $actionname, $objectnumber, $infos, $interface)=@_; + my ($modulename, $actionname, $objectnumber, $info, $interface)=@_; # Get ID of logged in user. if called from a batch job, # no user session exists and C4::Context->userenv() returns @@ -76,9 +72,11 @@ sub logaction { $usernumber ||= 0; $interface //= C4::Context->interface; + $info = condense($info); + my $dbh = C4::Context->dbh; my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info,interface) values (now(),?,?,?,?,?,?)"); - $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$infos,$interface); + $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$info,$interface); $sth->finish; my $logger = Koha::Logger->get( @@ -95,14 +93,30 @@ sub logaction { module => $modulename, action => $actionname, object => $objectnumber, - info => $infos + info => $info, } ); } ); } -=item cronlogaction +=head2 condense + +=cut + +sub condense { + my $info = shift; + return $info unless C4::Context->preference('LogCondenseLimit'); + + return $info if ref($info) eq q{} && length($info) <= C4::Context->preference('LogCondenseLimit'); + + my $rv = $info; + $rv = Dumper( $rv ) if ref($rv); + $rv = substr( $rv, 0, C4::Context->preference('LogCondenseLimit') ); + return $rv; +} + +=head2 cronlogaction &cronlogaction($infos); @@ -111,7 +125,6 @@ Logs the path and name of the calling script plus the information privided by pa =cut -#' sub cronlogaction { my ($infos)=@_; my $loginfo = (caller(0))[1]; --- a/t/db_dependent/Log.t +++ a/t/db_dependent/Log.t @@ -15,7 +15,8 @@ # with Koha; if not, see . use Modern::Perl; -use Test::More tests => 3; +use Test::More tests => 4; +use Data::Dumper qw( Dumper ); use C4::Context; use C4::Log qw( logaction cronlogaction ); @@ -30,6 +31,7 @@ use t::lib::TestBuilder; our $schema = Koha::Database->new->schema; $schema->storage->txn_begin; our $dbh = C4::Context->dbh; +our $builder = t::lib::TestBuilder->new; subtest 'Existing tests' => sub { plan tests => 3; @@ -95,7 +97,6 @@ subtest 'logaction(): interface is correctly logged' => sub { subtest 'GDPR logging' => sub { plan tests => 6; - my $builder = t::lib::TestBuilder->new; my $patron = $builder->build_object( { class => 'Koha::Patrons' } ); t::lib::Mocks::mock_userenv({ patron => $patron }); @@ -150,4 +151,38 @@ subtest 'GDPR logging' => sub { is( $logs->count, 1, 'We expect only one auth success line for this patron' ); }; +subtest 'Condense logging' => sub { + plan tests => 4; + + # Log a patron object + my $patron = $builder->build_object( { class => 'Koha::Patrons' } ); + t::lib::Mocks::mock_preference('LogCondenseLimit', 2000 ); + logaction( "MEMBERS", "MODIFY", $patron->id, $patron, 'test1' ); + my $logs = Koha::ActionLogs->search({ object => $patron->id }); + my $rec = $logs->next; + is( length($rec->info), 2000, 'First 2000 chars in log' ); + + # Lower limit + t::lib::Mocks::mock_preference('LogCondenseLimit', 1000 ); + logaction( "MEMBERS", "MODIFY", $patron->id, $patron, 'test2' ); + #$logs->reset; + $rec = $logs->search({ interface => 'test2' })->next; + is( length($rec->info), 1000, 'First 1000 chars found as expected' ); + + # Log an unblessed hold + t::lib::Mocks::mock_preference('LogCondenseLimit', 200 ); + my $hold_unblessed = $builder->build_object( { class => 'Koha::Holds' } )->unblessed; + my $info = Dumper( $hold_unblessed ); + logaction( "HOLDS", "TEST", $hold_unblessed->{reserve_id}, $hold_unblessed, 'test3' ); + $logs = Koha::ActionLogs->search({ object => $hold_unblessed->{reserve_id}, interface => 'test3' }); + $rec = $logs->next; + is( $rec->info, substr($info, 0, 200), 'Dump of unblessed hold found' ); + + # Pass a too long string + logaction( "HOLDS", "TEST", $hold_unblessed->{reserve_id}, $info, 'test4' ); + $logs = Koha::ActionLogs->search({ object => $hold_unblessed->{reserve_id}, interface => 'test4' }); + $rec = $logs->next; + is( length($rec->info), 200, 'First 200 chars found as expected' ); +}; + $schema->storage->txn_rollback; --