perl/liblog-dispatch-gelf-perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 1.3.1

Browse Source
This commit is contained in:
Mario Fetka
2018-02-25 14:27:18 +01:00
commit e41fbc35c0
14 changed files with 1369 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
t/00_compile.t Normal file
View File

@@ -0,0 +1,9 @@
use strict;
use Test::More 0.98;
use_ok $_ for qw(
Log::Dispatch::Gelf
);
done_testing;

80
t/01_log_format.t Normal file
View File

@@ -0,0 +1,80 @@
use strict;
use Test::More;
use Test::Exception;
use Log::Dispatch;
use JSON;
my $LAST_LOG_MSG;
my $log = Log::Dispatch->new(
outputs => [ [
'Gelf',
min_level => 'debug',
additional_fields => { facility => __FILE__ },
send_sub => sub { $LAST_LOG_MSG = $_[0] },
] ],
);
$log->info("It works\nMore details.");
note "formatted message: $LAST_LOG_MSG";
my $msg = decode_json($LAST_LOG_MSG);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'It works', 'short_message correct');
is($msg->{full_message}, "It works\nMore details.", 'full_message correct');
is($msg->{_facility}, __FILE__, 'facility correct');
ok($msg->{host}, 'host is there');
ok($msg->{timestamp}, 'timestamp is there');
ok($msg->{version}, 'version is there');
dies_ok {
$log->log(
level => 'info',
message => "It works\nMore details.",
additional_fields => 'not a hashref'
);
}
'additional_fields wrong type';
$log->log(
level => 'info',
message => "It works\nMore details.",
additional_fields => { additional => 1 }
);
note "formatted message: $LAST_LOG_MSG";
$msg = decode_json($LAST_LOG_MSG);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'It works', 'short_message correct');
is($msg->{full_message}, "It works\nMore details.", 'full_message correct');
is($msg->{_facility}, __FILE__, 'facility correct');
is($msg->{_additional}, 1, 'additional log field correct');
ok($msg->{host}, 'host is there');
ok($msg->{timestamp}, 'timestamp is there');
ok($msg->{version}, 'version is there');
$log->log(
level => 'info',
message => "It works\nMore details.",
additional_fields => { facility => 'override' }
);
note "formatted message: $LAST_LOG_MSG";
$msg = decode_json($LAST_LOG_MSG);
is($msg->{_facility}, 'override', 'facility overridden correctly');
$log->log(
level => 'info',
message => "It works\nMore details.",
);
note "formatted message: $LAST_LOG_MSG";
$msg = decode_json($LAST_LOG_MSG);
is($msg->{_facility}, __FILE__, 'override is temporary');
done_testing(18);

165
t/02_socket.t Executable file
View File

@@ -0,0 +1,165 @@
use strict;
use warnings;
use Test::More;
use Log::Dispatch;
use JSON;
use Test::Exception;
use Mock::Quick;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf', min_level => 'debug',
]
],
);
}
qr/^Must be set socket or send_sub/, 'empty socket';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
'socket' => {}
]
],
);
}
qr/socket host must be set/, 'undefined socket host';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
'socket' => {
host => ''
}
]
],
);
}
qr/socket host must be set/, 'empty socket host';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
'socket' => {
host => 'test',
port => 'x',
}
]
],
);
}
qr/socket port must be integer/, 'invalid socket port';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
'socket' => {
host => 'test',
port => '111111',
protocol => 'invalid',
}
]
],
);
}
qr/socket protocol must be tcp or udp/, 'invalid protocol';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
'socket' => {
host => 'test',
port => '111111',
protocol => 'xxx-udp',
}
]
],
);
}
qr/socket protocol must be tcp or udp/, 'invalid protocol 2';
my $LAST_LOG_MSG;
my $class_inet = qclass(
-implement => 'IO::Socket::INET',
new => sub {
my ($obj, %options) = @_;
is_deeply(\%options, { PeerAddr => 'test', PeerPort => 12201, Proto => 'udp' }, 'connect opts');
return bless {}, $obj;
},
send => sub {
my ($self, $msg) = @_;
$LAST_LOG_MSG = $msg;
}
);
my $log = Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
socket => {
host => 'test',
}
]
],
);
$log->info("It works\nMore details.");
note("formatted message: $LAST_LOG_MSG");
my $msg = decode_json($LAST_LOG_MSG);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'It works', 'short_message correct');
is($msg->{full_message}, "It works\nMore details.", 'full_message correct');
$log = Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
compress => 1,
socket => {
host => 'test',
}
]
],
);
$log->info("Compressed\nMore details.");
my $output;
gunzip \$LAST_LOG_MSG => \$output
or die "gunzip failed: $GunzipError\n";
note("formatted message: $output");
$msg = decode_json($output);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'Compressed', 'short_message correct');
is($msg->{full_message}, "Compressed\nMore details.", 'full_message correct');
done_testing(14);

162
t/03_chunked.t Normal file
View File

@@ -0,0 +1,162 @@
use strict;
use warnings;
use Test::More;
use Log::Dispatch;
use Log::GELF::Util qw(dechunk decode_chunk uncompress);
use JSON;
use Test::Exception;
use Mock::Quick;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
my @ACCUMULATOR;
my $MESSAGE;
my $class_inet = qclass(
-implement => 'IO::Socket::INET',
new => sub {
my ($obj, %options) = @_;
@ACCUMULATOR = undef;
$MESSAGE = undef;
return bless {}, $obj;
},
send => sub {
my ($self, $encoded_chunk) = @_;
$MESSAGE = dechunk(
\@ACCUMULATOR,
decode_chunk($encoded_chunk)
);
$MESSAGE = uncompress($MESSAGE) if $MESSAGE;
}
);
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => 'WAN',
'socket' => {
host => 'test',
protocol => 'tcp',
}
]
],
);
}
qr/chunked only applicable to udp/, 'invalid protocol for chunking';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => 'xxx',
'socket' => {
host => 'test',
protocol => 'udp',
}
]
],
);
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/, 'invalid chunked value';
throws_ok {
Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => '-1',
'socket' => {
host => 'test',
protocol => 'udp',
}
]
],
);
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/, 'invalid integer';
new_ok ( 'Log::Dispatch', [
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => 'WAN',
socket => {
host => 'test',
}
]
]
]
);
new_ok ( 'Log::Dispatch', [
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => 'lan',
socket => {
host => 'test',
}
]
]
]
);
my $log = Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
chunked => 4,
socket => {
host => 'test',
}
]
],
);
$log->info("Uncompressed - chunked\nMore details.");
note("formatted message: $MESSAGE");
my $msg = decode_json($MESSAGE);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'Uncompressed - chunked', 'short_message correct');
is($msg->{full_message}, "Uncompressed - chunked\nMore details.", 'full_message correct');
$log = Log::Dispatch->new(
outputs => [
[
'Gelf',
min_level => 'debug',
compress => 1,
chunked => 4,
socket => {
host => 'test',
}
]
],
);
$log->info("Compressed - chunked\nMore details.");
note("formatted message: $MESSAGE");
$msg = decode_json($MESSAGE);
is($msg->{level}, 6, 'correct level info');
is($msg->{short_message}, 'Compressed - chunked', 'short_message correct');
is($msg->{full_message}, "Compressed - chunked\nMore details.", 'full_message correct');
done_testing(11);