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

Imported Upstream version 0.96

Browse Source
This commit is contained in:
Mario Fetka
2018-02-25 14:46:41 +01:00
commit a6db65a701
16 changed files with 2221 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::GELF::Util
);
done_testing(1);

147
t/01_utilities.t Normal file
View File

@@ -0,0 +1,147 @@
use strict;
use Test::More 0.98;
use Test::Exception;
use Log::GELF::Util qw(parse_size parse_level);
throws_ok{
my %msg = parse_size();
}
qr/0 parameters were passed.*/,
'parse_size mandatory parameters missing';
throws_ok{
my %msg = parse_size({});
}
qr/Parameter #1.*/,
'parse_size wrong type';
throws_ok{
my %msg = parse_size(-1);
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/,
'parse_size invalid numeric value';
throws_ok{
my %msg = parse_size('wrong');
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/,
'parse_size invalid string value';
my $size;
lives_ok{
$size = parse_size(1);
}
'numeric size';
is($size, 1, 'correct numeric size');
lives_ok{
$size = parse_size('lan');
}
'string lan size';
is($size, 8152, 'correct lan size');
lives_ok{
$size = parse_size('LAN');
}
'string LAN size';
is($size, 8152, 'correct LAN size');
lives_ok{
$size = parse_size('wan');
}
'string wan size';
is($size, 1420, 'correct numeric size');
lives_ok{
$size = parse_size('WAN');
}
'string WAN size';
is($size, 1420, 'correct WAN size');
throws_ok{
parse_level();
}
qr/0 parameters were passed.*/,
'parse_level mandatory parameters missing';
throws_ok{
parse_level({});
}
qr/Parameter #1.*/,
'parse_level wrong type';
throws_ok{
parse_level(-1);
}
qr/level must be between 0 and 7 or a valid log level string/,
'parse_level invalid numeric value';
throws_ok{
parse_level(8);
}
qr/level must be between 0 and 7 or a valid log level string/,
'parse_level invalid numeric value - too big';
throws_ok{
parse_level('wrong');
}
qr/level must be between 0 and 7 or a valid log level string/,
'parse_level invalid string value';
my $level;
lives_ok{
$level = parse_level(0);
}
'correct numeric level';
is($level, 0, 'correct numeric level min');
lives_ok{
$level = parse_level(7);
}
'correct numeric level';
is($level, 7, 'correct numeric level max');
my $level_no = 0;
foreach my $lvl_name (
qw(
emerg
alert
crit
err
warn
notice
info
debug
)
) {
lives_ok{
$level = parse_level($lvl_name);
}
"level $lvl_name ok";
is($level, $level_no++, "level $lvl_name correct value");
}
$level_no = 0;
foreach my $lvl_name (
qw(
emergency
alert
critical
error
warning
notice
information
debug
)
) {
lives_ok{
$level = parse_level($lvl_name);
}
"level long $lvl_name ok";
is($level, $level_no++, "level long $lvl_name correct value");
}
done_testing(55);

174
t/02_validate.t Normal file
View File

@@ -0,0 +1,174 @@
use strict;
use Test::More 0.98;
use Test::Exception;
use Test::Warnings 0.005 qw(warning allow_warnings);
use Log::GELF::Util qw(validate_message);
throws_ok{
validate_message();
}
qr/Mandatory parameter 'short_message' missing.*/,
'mandatory parameters missing';
throws_ok{
validate_message(
version => '1.x',
host => 1,
short_message => 1,
);
}
qr/version must be 1.1, supplied.*/,
'version check';
throws_ok{
validate_message(
host => 1,
short_message => 1,
level => 'x',
);
}
qr/level must be between 0 and 7 or a valid log level string/,
'level check';
throws_ok{
validate_message(
host => 1,
short_message => 1,
timestamp => 'x',
);
}
qr/bad timestamp/,
'timestamp check';
throws_ok{
validate_message(
host => 1,
short_message => 1,
bad => 'to the bone.',
);
}
qr/invalid field 'bad'.*/,
'bad field check';
throws_ok{
validate_message(
host => 1,
short_message => 1,
'bad name' => 'to the bone.',
);
}
qr/invalid field 'bad name'.*/,
'bad field check 2';
allow_warnings 1; #throws legit warnings
throws_ok{
validate_message(
host => 1,
short_message => 1,
facility => {},
);
}
qr/The 'facility' parameter.*/,
'bad facility check';
throws_ok{
validate_message(
host => 1,
short_message => 1,
line => 'wrong',
);
}
qr/line must be a number/,
'bad line check';
allow_warnings 0;
like( warning {
validate_message(
host => 1,
short_message => 1,
facility => 1,
);
},
qr/^facility is deprecated.*/,
'facility deprecated');
like( warning {
validate_message(
host => 1,
short_message => 1,
line => 1,
);
},
qr/^line is deprecated.*/,
'line deprecated');
like( warning {
validate_message(
host => 1,
short_message => 1,
file => 1,
);
},
qr/^file is deprecated.*/,
'file deprecated');
my $msg;
lives_ok{
$msg = validate_message(
host => 1,
short_message => 1,
);
}
'default version';
my $time = time;
is($msg->{version}, '1.1', 'correct default version');
like($msg->{timestamp}, qr/\d+\.\d+/, 'default timestamp');
is($msg->{level}, 1, 'default level');
lives_ok{
$msg = validate_message(
host => 1,
short_message => 1,
level => 2,
);
}
'numeric level';
is($msg->{level}, 2, 'default level');
lives_ok{
$msg = validate_message(
host => 1,
short_message => 1,
level => 'err',
);
}
'numeric level';
is($msg->{level}, 3, 'default level');
allow_warnings 1; #throws legit warnings
lives_ok{
$msg = validate_message(
host => 1,
short_message => 1,
facility => 1,
);
}
'facility check';
ok(exists $msg->{facility}, 'line exists');
is($msg->{facility}, '1', 'correct facility');
lives_ok{
$msg = validate_message(
host => 1,
short_message => 1,
line => 1,
);
}
'line check';
ok(exists $msg->{line}, 'line exists');
is($msg->{line}, '1', 'correct line');
allow_warnings 0;
done_testing(26);

60
t/03_encode.t Normal file
View File

@@ -0,0 +1,60 @@
use strict;
use Test::More 0.98;
use Test::Exception;
use JSON::MaybeXS qw(decode_json);
use Log::GELF::Util qw(encode decode);
throws_ok{
my %msg = encode();
}
qr/0 parameters were passed.*/,
'mandatory encode parameter missing';
throws_ok{
my %msg = encode({});
}
qr/Mandatory parameter 'short_message' missing.*/,
'mandatory encode parameters missing';
my $msg;
lives_ok{
$msg = decode_json(encode(
{
host => 'host',
short_message => 'message',
}
));
}
'encodes ok';
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
throws_ok{
my %msg = decode();
}
qr/0 parameters were passed.*/,
'mandatory decode parameter missing';
throws_ok{
my %msg = decode("{}");
}
qr/Mandatory parameter 'short_message' missing.*/,
'mandatory encode parameters missing';
lives_ok{
$msg = decode(encode(
{
host => 'host',
short_message => 'message',
}
));
}
'encodes ok';
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
done_testing(10);

116
t/04_compress.t Normal file
View File

@@ -0,0 +1,116 @@
use strict;
use Test::More 0.91;
use Test::Exception;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use IO::Uncompress::Inflate qw(inflate $InflateError) ;
use JSON::MaybeXS qw(decode_json);
use Log::GELF::Util qw(encode compress uncompress);
throws_ok{
my %msg = compress();
}
qr/0 parameters were passed.*/,
'mandatory parameter missing';
throws_ok{
compress({});
}
qr/Parameter #1.*/,
'message parameters wrong type';
throws_ok{
my %msg = compress(1,'wrong');
}
qr/compression type must be gzip \(default\) or zlib/,
'type parameters wrong';
throws_ok{
my %msg = uncompress();
}
qr/0 parameters were passed.*/,
'mandatory parameter missing';
throws_ok{
my %msg = uncompress(
{},
);
}
qr/Parameter #1.*/,
'message parameters wrong type';
lives_ok{
compress( 1, 'gzip');
}
'gzips explicit ok';
lives_ok{
compress( 1, 'zlib');
}
'zlib explicit ok';
my $msgz;
lives_ok{
$msgz = compress(
encode(
{
host => 'host',
short_message => 'message',
}
)
);
}
'gzips ok';
my $msgj;
gunzip \$msgz => \$msgj
or die "gunzip failed: $GunzipError";
my $msg = decode_json($msgj);
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
lives_ok{
$msg = decode_json(
uncompress($msgz)
);
}
'uncompresses gzip ok';
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
my $msgz;
lives_ok{
$msgz = compress(
encode(
{
host => 'host',
short_message => 'message',
}
),
'zlib',
);
}
'deflates ok';
my $msgj;
inflate \$msgz => \$msgj
or die "inflate failed: $InflateError";
my $msg = decode_json($msgj);
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
lives_ok{
$msg = decode_json(
uncompress($msgz)
);
}
'uncompresses zlib ok';
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
done_testing(19);

186
t/05_chunked.t Normal file
View File

@@ -0,0 +1,186 @@
use strict;
use warnings;
use Test::More;
use Test::Exception;
use List::Util qw(shuffle);
use Math::Random::MT qw(irand);
use Log::GELF::Util qw(
decode_chunk
compress
uncompress
is_chunked
enchunk
dechunk
decode_chunk
encode
$GELF_MSG_MAGIC
);
use JSON::MaybeXS qw(decode_json);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use IO::Uncompress::Inflate qw(inflate $InflateError);
sub test_dechunk {
my @chunks;
my $msg;
do {
$msg = dechunk(\@chunks, decode_chunk(shift()));
} until ($msg);
return uncompress( $msg );
};
throws_ok{
is_chunked();
}
qr/0 parameters were passed.*/,
'mandatory parameters missing';
ok( ! is_chunked( 'no magic' ), 'no magic' );
ok( is_chunked( $GELF_MSG_MAGIC ), 'magic' );
throws_ok{
enchunk();
}
qr/0 parameters were passed to Log::GELF::Util::enchunk but 3 were expected/,
'mandatory parameters missing';
throws_ok{
enchunk('0123456789', -1);
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/,
'enchunk negative size';
throws_ok{
enchunk('0123456789', 'xxx');
}
qr/chunk size must be "lan", "wan", a positve integer, or 0 \(no chunking\)/,
'enchunk bad size';
my @chunks;
lives_ok{
@chunks = enchunk('0123456789');
}
'enchunks ok - size default';
lives_ok{
@chunks = enchunk('0123456789', 0);
}
'enchunks ok - 0';
is(scalar @chunks, 1, 'correct number of chunks - 0');
lives_ok{
@chunks = enchunk('0123456789', 1);
}
'enchunks ok - 1';
is(scalar @chunks, 10, 'correct number of chunks - 1');
lives_ok{
@chunks = enchunk(
encode(
{
host => 'host',
short_message => 'message',
}
),
4
);
}
'enchunks ok - message';
throws_ok{
decode_chunk();
}
qr/0 parameters were passed.*/,
'mandatory parameter to decode_chunk missing';
my $chunk;
lives_ok{
$chunk = decode_chunk($chunks[0]);
}
'decode chunk succeeds';
ok($chunk->{id}, 'id exists');
is($chunk->{sequence_number}, 0, 'sequence correct');
is($chunk->{sequence_count}, scalar @chunks, 'sequence correct');
is(length($chunk->{data}), 4, 'chunk size correct');
my $msg = decode_json(test_dechunk(@chunks));
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct default version');
lives_ok{
@chunks = enchunk(
compress(
encode(
{
host => 'host',
short_message => 'message',
}
)
),
4
);
}
'enchunks compressed gzip ok';
foreach my $i (1 .. 10) {
$msg = decode_json(test_dechunk(shuffle @chunks));
is($msg->{version}, '1.1', "correct default version $i");
is($msg->{host}, 'host', "correct host $i");
}
lives_ok{
@chunks = enchunk(
compress(
encode(
{
host => 'host',
short_message => 'message',
}
),
'zlib',
),
4
);
}
'enchunks compressed zlib ok';
$msg = decode_json(test_dechunk(@chunks));
is($msg->{version}, '1.1', 'correct default version');
is($msg->{host}, 'host', 'correct host');
throws_ok{
enchunk('0123456789', 2, '1234');
}
qr/message id must be 8 bytes/,
'message id bad size';
my @message_id = ( 1498382863, 3314914434 );
my $message_id = pack('L*', @message_id );
lives_ok{
@chunks = enchunk('0123456789', 2, $message_id );
}
'enchunks with message id';
my %ids;
foreach my $chunk (@chunks) {
my $decoded_chunk = decode_chunk($chunk);
$ids{$decoded_chunk->{id}} = 1;
}
is(scalar keys %ids, 1, 'one id across chunks');
$msg = decode_chunk(shift @chunks);
is($msg->{id}, $message_id, 'correct packed message id');
is((join '', unpack('LL', $msg->{id})), (join '', @message_id), 'correct message id');
done_testing(49);