perl/liblog-log4perl-appender-graylog-perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 1.7

Browse Source
This commit is contained in:
Mario Fetka
2018-03-27 20:36:01 +02:00
commit ccecbd3ce6
17 changed files with 1557 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::Log4perl::Appender::Graylog
);
done_testing;

95
t/01-log-plain.t Normal file
View File

@@ -0,0 +1,95 @@
#!/usr/bin/env perl
use strict;
use warnings;
use JSON -convert_blessed_universally;
use Test::Most;
use Test::MockModule;
use Data::Faker;
use Data::Printer
output => 'stderr',
colored => 1,
deparse => 1,
caller_info => 1,
show_readonly => 1,
show_lvalue => 1,
max_depth => 5,
caller_info => 1,
class => { inherited => 'all', expand => 5 };
my $log;
subtest "Init Logger plain" => sub {
lives_ok {
use Log::Log4perl;
Log::Log4perl->reset();
use Log::Log4perl::Appender::Graylog;
use Log::Log4perl::Layout::NoopLayout;
my $config = <<'END';
log4perl.logger = DEBUG, SERVER
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
log4perl.appender.SERVER.layout = NoopLayout
log4perl.appender.SERVER.PeerAddr = 127.0.0.1
log4perl.appender.SERVER.PeerPort = 12209
log4perl.appender.SERVER.Proto = udp
log4perl.appender.SERVER.Gzip = 0
log4perl.appender.SERVER.Chunked = 0
END
Log::Log4perl->init_once( \$config );
$log = Log::Log4perl->get_logger("log1");
}
"lives through setting up logger";
};
subtest "sends though udp plain" => sub {
my $log_data = Data::Faker->new()->domain_name();
my $mock = Test::MockModule->new('IO::Socket::INET');
$mock->mock(
'new',
sub {
my $proto = shift;
my $class = ref $proto || $proto;
my %params = @_;
cmp_ok( $params{PeerAddr}, 'eq', "127.0.0.1",
"PeerAddr is set to localhost" );
cmp_ok( $params{PeerPort}, '==', 12209,
"PeerPort is set to 12209 and is a number" );
cmp_ok( $params{Proto}, 'eq', "udp", "Proto is set to udp" );
return bless \%params, $class;
}
);
$mock->mock(
'send',
sub {
my $self = shift;
my ($data) = @_;
my $json =
JSON->new->utf8->space_after->allow_nonref->convert_blessed;
my $result;
lives_ok {
$result = $json->decode($data);
}
"GELF message is json and can be reparsed";
cmp_ok( $result->{full_message},
"eq", $log_data, "full_message is $log_data" );
}
);
my $closed = 0;
$mock->mock(
'close',
sub {
$closed = 1;
}
);
$log->debug($log_data);
ok( $closed, "Connection verified closed" );
};
done_testing;

97
t/02-log-gzip.t Normal file
View File

@@ -0,0 +1,97 @@
#!/usr/bin/env perl
use strict;
use warnings;
use JSON -convert_blessed_universally;
use Test::Most;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
use Test::MockModule;
use Data::Faker;
use Data::Printer
output => 'stderr',
colored => 1,
deparse => 1,
caller_info => 1,
show_readonly => 1,
show_lvalue => 1,
max_depth => 5,
caller_info => 1,
class => { inherited => 'all', expand => 5 };
my $log;
subtest "Init Logger plain" => sub {
lives_ok {
use Log::Log4perl;
Log::Log4perl->reset();
use Log::Log4perl::Appender::Graylog;
use Log::Log4perl::Layout::NoopLayout;
my $config = <<'END';
log4perl.logger = DEBUG, SERVER
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
log4perl.appender.SERVER.layout = NoopLayout
log4perl.appender.SERVER.PeerAddr = 127.0.0.1
log4perl.appender.SERVER.PeerPort = 12209
log4perl.appender.SERVER.Proto = udp
log4perl.appender.SERVER.Gzip = 1
log4perl.appender.SERVER.Chunked = 0
END
Log::Log4perl->init_once( \$config );
$log = Log::Log4perl->get_logger("log1");
}
"lives through setting up logger";
};
subtest "sends though udp plain" => sub {
my $log_data = Data::Faker->new()->domain_name();
my $mock = Test::MockModule->new('IO::Socket::INET');
$mock->mock(
'new',
sub {
my $proto = shift;
my $class = ref $proto || $proto;
my %params = @_;
cmp_ok( $params{PeerAddr}, 'eq', "127.0.0.1",
"PeerAddr is set to localhost" );
cmp_ok( $params{PeerPort}, '==', 12209,
"PeerPort is set to 12209 and is a number" );
cmp_ok( $params{Proto}, 'eq', "udp", "Proto is set to udp" );
return bless \%params, $class;
}
);
$mock->mock(
'send',
sub {
my $self = shift;
my ($gzdata) = @_;
my $data;
gunzip \$gzdata => \$data or die "gunzip failed: $GunzipError\n";
my $json =
JSON->new->utf8->space_after->allow_nonref->convert_blessed;
my $result;
lives_ok {
$result = $json->decode($data);
}
"GELF message is json and can be reparsed";
cmp_ok( $result->{full_message},
"eq", $log_data, "full_message is $log_data" );
}
);
my $closed = 0;
$mock->mock(
'close',
sub {
$closed = 1;
}
);
$log->debug($log_data);
ok( $closed, "Connection verified closed" );
};
done_testing;

33
t/DTO/00-compile.t Normal file
View File

@@ -0,0 +1,33 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Moose::More;
use Data::DTO::GELF;
use Readonly;
Readonly my $CLASS => 'Data::DTO::GELF';
subtest "$CLASS Is valid object." => sub {
meta_ok($CLASS);
};
subtest "$CLASS has correct attributes" => sub {
has_attribute_ok( $CLASS, 'version' );
has_attribute_ok( $CLASS, 'host' );
has_attribute_ok( $CLASS, 'short_message' );
has_attribute_ok( $CLASS, 'full_message' );
has_attribute_ok( $CLASS, 'timestamp' );
has_attribute_ok( $CLASS, 'level' );
};
subtest "$CLASS has correct predicates, clearers, writers, and builders" =>
sub {
has_method_ok( $CLASS, '_build_version' );
has_method_ok( $CLASS, '_build_timestamp' );
};
done_testing();

62
t/DTO/01-instance.t Normal file
View File

@@ -0,0 +1,62 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::Most;
use Test::Moose::More;
use Data::DTO::GELF;
use Data::UUID;
use POSIX qw(strftime);
use Data::Random::String;
use JSON -convert_blessed_universally;
use Readonly;
Readonly my $CLASS => 'Data::DTO::GELF';
my $obj;
my $data = {
'full_message' => Data::Random::String->create_random_string(
length => '100',
contains => 'alpha'
),
'level' => "DEBUG",
'_timestr' => strftime( "%Y-%m-%d %H:%M:%S", gmtime( time() ) ),
'_uuid' => Data::UUID->new()->create_str(),
};
subtest "$CLASS Is valid object." => sub {
lives_ok {
$obj = $CLASS->new($data)
}
"Lives though creating instance if $CLASS";
ok( $obj, "$CLASS is Instanced" );
};
subtest "$CLASS has proper values" => sub {
cmp_ok( $obj->version(), "eq", "1.1", "Version tag is 1.1" );
cmp_ok( $obj->full_message(), "eq", $data->{full_message},
"Full message is ok" );
cmp_ok(
$obj->short_message(), "eq",
( substr $data->{full_message}, 0, 100 ),
"Short message is full message truncated to 100 chars."
);
cmp_ok( $obj->level(), "==", "0", "DEBUG level is coerced to 0" );
ok( defined $obj->timestamp(), "Timestamp is defined" );
cmp_ok( $obj->_uuid(), "eq", $data->{_uuid},
"Dynamic _var's were created" );
};
subtest "$CLASS hashifys for TO_JSON" => sub {
lives_ok {
my $json = JSON->new->allow_nonref->convert_blessed;
my $j = $json->encode($obj);
ok( defined $j, "Has JSON value" );
}
"Lives through converting to json";
};
done_testing();