Attachment #126919 for bug #29321

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




# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use Data::Dumper qw( Dumper );

use JSON qw( to_json );

use C4::Context;


=head1 SYNOPSIS

use C4::Log;

=head1 DESCRIPTION



=head1 FUNCTIONS

=head2 logaction

=item logaction

  &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


=cut

#'
sub logaction {
    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

    $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,$info,$interface);
    $sth->finish;

    my $logger = Koha::Logger->get(

                    module => $modulename,
                    action => $actionname,
                    object => $objectnumber,
                    info   => $info,
                }
            );
        }
    );
}

=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);



=cut

#'
sub cronlogaction {
    my ($infos)=@_;
    my $loginfo = (caller(0))[1];




# with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use Test::More tests => 4;
use Data::Dumper qw( Dumper );

use C4::Context;
use C4::Log qw( logaction cronlogaction );

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;

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 });

    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;
- 

Return to bug 29321

Lines 21-29 package C4::Log; Link Here

(-)a/C4/Log.pm (-14 / +27 lines)
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];

Lines 15-21 Link Here

(-)a/t/db_dependent/Log.t (-3 / +37 lines)
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	-