ettore.dreucci/mk_livestatus
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

initial commit

Browse Source
This commit is contained in:
Phillip Smith
2021-08-24 17:55:37 +10:00
commit 69e42aac8d
387 changed files with 69168 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

149
api/perl/t/01-Monitoring-Livestatus-basic_tests.t Normal file
View File

@@ -0,0 +1,149 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use File::Temp;
use Data::Dumper;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 35;
}
}
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus->new( $socket_path );
isa_ok($ml, 'Monitoring::Livestatus', 'single args');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus->new(
verbose => 0,
socket => $socket_path,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'new hash args');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# create object with peer arg
$ml = Monitoring::Livestatus->new(
peer => $socket_path,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg socket');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'peer backend UNIX');
#########################
# create object with peer arg
my $server = 'localhost:12345';
$ml = Monitoring::Livestatus->new(
peer => $server,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg server');
is($ml->peer_name(), $server, 'get peer_name()');
is($ml->peer_addr(), $server, 'get peer_addr()');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'peer backend INET');
#########################
# create multi object with peers
$ml = Monitoring::Livestatus->new(
peer => [ $server, $socket_path ],
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi');
my @names = $ml->peer_name();
my @addrs = $ml->peer_addr();
my $name = $ml->peer_name();
my $expect = [ $server, $socket_path ];
is_deeply(\@names, $expect, 'list context get peer_name()') or diag("got peer names: ".Dumper(\@names)."but expected: ".Dumper($expect));
is($name, 'multiple connector', 'scalar context get peer_name()') or diag("got peer name: ".Dumper($name)."but expected: ".Dumper('multiple connector'));
is_deeply(\@addrs, $expect, 'list context get peer_addr()') or diag("got peer addrs: ".Dumper(\@addrs)."but expected: ".Dumper($expect));
#########################
# create multi object with peers and name
$ml = Monitoring::Livestatus->new(
peer => [ $server, $socket_path ],
name => 'test multi',
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with name');
$name = $ml->peer_name();
is($name, 'test multi', 'peer_name()');
#########################
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
keepalive => 1,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with keepalive');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# timeout checks
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
timeout => 13,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
is($ml->{'connect_timeout'}, 13, 'connect_timeout');
is($ml->{'query_timeout'}, 13, 'query_timeout');
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
query_timeout => 14,
connect_timeout => 17,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
is($ml->{'connect_timeout'}, 17, 'connect_timeout');
is($ml->{'query_timeout'}, 14, 'query_timeout');
#########################
# error retry
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
retries_on_connection_error => 3,
retry_interval => 1,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with error retry');
#########################
# cleanup
unlink($socket_path);

148
api/perl/t/02-Monitoring-Livestatus-internals.t Normal file
View File

@@ -0,0 +1,148 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use File::Temp;
use Data::Dumper;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 14;
}
}
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus->new( 'localhost:12345' );
isa_ok($ml, 'Monitoring::Livestatus', 'single args server');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'single args server peer');
is($ml->{'CONNECTOR'}->peer_name, 'localhost:12345', 'single args server peer name');
is($ml->{'CONNECTOR'}->peer_addr, 'localhost:12345', 'single args server peer addr');
#########################
# create object with single arg
$ml = Monitoring::Livestatus->new( $socket_path );
isa_ok($ml, 'Monitoring::Livestatus', 'single args socket');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'single args socket peer');
is($ml->{'CONNECTOR'}->peer_name, $socket_path, 'single args socket peer name');
is($ml->{'CONNECTOR'}->peer_addr, $socket_path, 'single args socket peer addr');
my $header = "404 43\n";
my($error,$error_msg) = $ml->_parse_header($header);
is($error, '404', 'error code 404');
isnt($error_msg, undef, 'error code 404 message');
#########################
my $stats_query1 = "GET services
Stats: state = 0
Stats: state = 1
Stats: state = 2
Stats: state = 3
Stats: state = 4
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2
Stats: host_state != 0
Stats: state = 3
Stats: active_checks = 1
StatsAnd: 3
Stats: state = 3
Stats: active_checks = 1
StatsOr: 2";
my @expected_keys1 = (
'state = 0',
'state = 1',
'state = 2',
'state = 3',
'state = 4',
'host_state != 0 && state = 1',
'host_state != 0 && state = 2',
'host_state != 0 && state = 3',
'host_state != 0 && state = 3 && active_checks = 1',
'state = 3 || active_checks = 1',
);
my @got_keys1 = @{$ml->_extract_keys_from_stats_statement($stats_query1)};
is_deeply(\@got_keys1, \@expected_keys1, 'statsAnd, statsOr query keys')
or ( diag('got keys: '.Dumper(\@got_keys1)) );
#########################
my $stats_query2 = "GET services
Stats: state = 0 as all_ok
Stats: state = 1 as all_warning
Stats: state = 2 as all_critical
Stats: state = 3 as all_unknown
Stats: state = 4 as all_pending
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2 as all_warning_on_down_hosts
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2 as all_critical_on_down_hosts
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2 as all_unknown_on_down_hosts
Stats: host_state != 0
Stats: state = 3
Stats: active_checks_enabled = 1
StatsAnd: 3 as all_unknown_active_on_down_hosts
Stats: state = 3
Stats: active_checks_enabled = 1
StatsOr: 2 as all_active_or_unknown";
my @expected_keys2 = (
'all_ok',
'all_warning',
'all_critical',
'all_unknown',
'all_pending',
'all_warning_on_down_hosts',
'all_critical_on_down_hosts',
'all_unknown_on_down_hosts',
'all_unknown_active_on_down_hosts',
'all_active_or_unknown',
);
my @got_keys2 = @{$ml->_extract_keys_from_stats_statement($stats_query2)};
is_deeply(\@got_keys2, \@expected_keys2, 'stats query keys2')
or ( diag('got keys: '.Dumper(\@got_keys2)) );
#########################
my $normal_query1 = "GET services
Columns: host_name as host is_flapping description as name state
";
my @expected_keys3 = (
'host',
'is_flapping',
'name',
'state',
);
my @got_keys3 = @{$ml->_extract_keys_from_columns_header($normal_query1)};
is_deeply(\@got_keys3, \@expected_keys3, 'normal query keys')
or ( diag('got keys: '.Dumper(\@got_keys3)) );
#########################
unlink($socket_path);

215
api/perl/t/03-Monitoring-Livestatus-MULTI-internals.t Normal file
View File

@@ -0,0 +1,215 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
use File::Temp;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus::MULTI');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 57;
}
}
#########################
# create 2 test sockets
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path1 = $fh->filename;
unlink($socket_path1);
my $listener1 = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path1,
) or die("failed to open $socket_path1 as test socket: $!");
$fh = File::Temp->new(UNLINK => 0);
my $socket_path2 = $fh->filename;
unlink($socket_path2);
my $listener2 = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path2,
) or die("failed to open $socket_path2 as test socket: $!");
#########################
# test the _merge_answer
my $mergetests = [
{ # simple test for sliced selectall_arrayref
in => { '820e03551b95b42ec037c87aed9b8f4a' => [ { 'description' => 'test_flap_07', 'host_name' => 'test_host_000', 'state' => '0' }, { 'description' => 'test_flap_11', 'host_name' => 'test_host_000', 'state' => '0' } ],
'35bbb11a888f66131d429efd058fb141' => [ { 'description' => 'test_ok_00', 'host_name' => 'test_host_000', 'state' => '0' }, { 'description' => 'test_ok_01', 'host_name' => 'test_host_000', 'state' => '0' } ],
'70ea8fa14abb984761bdd45ef27685b0' => [ { 'description' => 'test_critical_00', 'host_name' => 'test_host_000', 'state' => '2' }, { 'description' => 'test_critical_19', 'host_name' => 'test_host_000', 'state' => '2' } ]
},
exp => [
{ 'description' => 'test_flap_07', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_flap_11', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_ok_00', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_ok_01', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_critical_00', 'host_name' => 'test_host_000', 'state' => '2' },
{ 'description' => 'test_critical_19', 'host_name' => 'test_host_000', 'state' => '2' },
]
},
];
#########################
# test object creation
my $ml = Monitoring::Livestatus::MULTI->new( [ $socket_path1, $socket_path2 ] );
isa_ok($ml, 'Monitoring::Livestatus', 'single args sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single args sockets peer');
}
$ml = Monitoring::Livestatus::MULTI->new( [$socket_path1] );
isa_ok($ml, 'Monitoring::Livestatus', 'single array args socket');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single array args socket peer');
is($peer->peer_addr, $socket_path1, 'single arrays args socket peer addr');
is($peer->peer_name, $socket_path1, 'single arrays args socket peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( 'localhost:5001' );
isa_ok($ml, 'Monitoring::Livestatus', 'single args server');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single args server peer');
like($peer->peer_addr, qr/^localhost/, 'single args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( ['localhost:5001'] );
isa_ok($ml, 'Monitoring::Livestatus', 'single array args server');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single arrays args server peer');
like($peer->peer_addr, qr/^localhost/, 'single arrays args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single arrays args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( [ 'localhost:5001', 'localhost:5002' ] );
isa_ok($ml, 'Monitoring::Livestatus', 'single args servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single args servers peer');
like($peer->peer_addr, qr/^localhost/, 'single args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => [ 'localhost:5001', 'localhost:5002' ] );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'hash args servers peer');
like($peer->peer_addr, qr/^localhost/, 'hash args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'hash args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => [ $socket_path1, $socket_path2 ] );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'hash args sockets peer');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => { $socket_path1 => 'Location 1', $socket_path2 => 'Location2' } );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args hashed sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'hash args hashed sockets peer');
like($peer->peer_name, qr/^Location/, 'hash args hashed sockets peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => { 'localhost:5001' => 'Location 1', 'localhost:5002' => 'Location2' } );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args hashed servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'hash args hashed servers peer');
like($peer->peer_addr, qr/^localhost/, 'hash args hashed servers peer addr');
like($peer->peer_name, qr/^Location/, 'hash args hashed servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( $socket_path1 );
isa_ok($ml, 'Monitoring::Livestatus', 'single args socket');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single args socket peer');
}
#########################
# test internal subs
$ml = Monitoring::Livestatus::MULTI->new('peer' => ['192.168.123.2:9996', '192.168.123.2:9997', '192.168.123.2:9998' ] );
my $x = 0;
for my $test (@{$mergetests}) {
my $got = $ml->_merge_answer($test->{'in'});
is_deeply($got, $test->{'exp'}, '_merge_answer test '.$x)
or diag("got: ".Dumper($got)."\nbut expected ".Dumper($test->{'exp'}));
$x++;
}
#########################
# test the _sum_answer
my $sumtests = [
{ # hashes
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => { 'ok' => '17', 'warning' => '7' },
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '42', 'warning' => '17' }
},
{ # hashes, undefs
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => undef,
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '25', 'warning' => '10' }
},
{ # hashes, undefs
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => {},
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '25', 'warning' => '10' }
},
{ # arrays
in => { '192.168.123.2:9996' => [ '3302', '235' ],
'192.168.123.2:9997' => [ '3324', '236' ],
'192.168.123.2:9998' => [ '3274', '236' ]
},
exp => [ 9900, 707 ]
},
{ # undefs / scalars
in => { 'e69322abf0352888e598da3e2514df4a' => undef,
'f42530d7e8c2b52732ba427b1e5e0a8e' => '1'
},
exp => 1,
},
{ # arrays, undefs
in => { '192.168.123.2:9996' => [ '2', '5' ],
'192.168.123.2:9997' => [ ],
'192.168.123.2:9998' => [ '4', '6' ]
},
exp => [ 6, 11 ]
},
{ # arrays, undefs
in => { '192.168.123.2:9996' => [ '2', '5' ],
'192.168.123.2:9997' => undef,
'192.168.123.2:9998' => [ '4', '6' ]
},
exp => [ 6, 11 ]
},
];
$x = 1;
for my $test (@{$sumtests}) {
my $got = $ml->_sum_answer($test->{'in'});
is_deeply($got, $test->{'exp'}, '_sum_answer test '.$x)
or diag("got: ".Dumper($got)."\nbut expected ".Dumper($test->{'exp'}));
$x++;
}
#########################
# clone test
my $clone = $ml->_clone($mergetests);
is_deeply($clone, $mergetests, 'merge test clone');
$clone = $ml->_clone($sumtests);
is_deeply($clone, $sumtests, 'sum test clone');

329
api/perl/t/20-Monitoring-Livestatus-test_socket.t Normal file
View File

@@ -0,0 +1,329 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use Data::Dumper;
use JSON::XS;
BEGIN {
eval {require threads;};
if ( $@ ) {
plan skip_all => 'need threads support for testing a real socket'
}
elsif( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else{
plan tests => 109
}
}
use File::Temp;
BEGIN { use_ok('Monitoring::Livestatus') };
#########################
# Normal Querys
#########################
my $line_seperator = 10;
my $column_seperator = 0;
my $test_data = [ ["alias","name","contacts"], # table header
["alias1","host1","contact1"], # row 1
["alias2","host2","contact2"], # row 2
["alias3","host3","contact3"], # row 3
];
my $test_hostgroups = [['']]; # test one row with no data
# expected results
my $selectall_arrayref1 = [ [ 'alias1', 'host1', 'contact1' ],
[ 'alias2', 'host2', 'contact2' ],
[ 'alias3', 'host3', 'contact3' ]
];
my $selectall_arrayref2 = [
{ 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' },
{ 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' },
{ 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' }
];
my $selectall_hashref = {
'host1' => { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' },
'host2' => { 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' },
'host3' => { 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' }
};
my $selectcol_arrayref1 = [ 'alias1', 'alias2', 'alias3' ];
my $selectcol_arrayref2 = [ 'alias1', 'host1', 'alias2', 'host2', 'alias3', 'host3' ];
my $selectcol_arrayref3 = [ 'alias1', 'host1', 'contact1', 'alias2', 'host2', 'contact2', 'alias3', 'host3', 'contact3' ];
my @selectrow_array = ( 'alias1', 'host1', 'contact1' );
my $selectrow_arrayref = [ 'alias1', 'host1', 'contact1' ];
my $selectrow_hashref = { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' };
#########################
# Single Querys
#########################
my $single_statement = "GET hosts\nColumns: alias\nFilter: name = host1";
my $selectscalar_value = 'alias1';
#########################
# Stats Querys
#########################
my $stats_statement = "GET services\nStats: state = 0\nStats: state = 1\nStats: state = 2\nStats: state = 3";
my $stats_data = [[4297,13,9,0]];
# expected results
my $stats_selectall_arrayref1 = [ [4297,13,9,0] ];
my $stats_selectall_arrayref2 = [ { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 } ];
my $stats_selectcol_arrayref = [ '4297' ];
my @stats_selectrow_array = ( '4297', '13', '9', '0' );
my $stats_selectrow_arrayref = [ '4297', '13', '9', '0' ];
my $stats_selectrow_hashref = { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 };
#########################
# Empty Querys
#########################
my $empty_statement = "GET services\nFilter: description = empty";
# expected results
my $empty_selectall_arrayref = [];
my $empty_selectcol_arrayref = [];
my @empty_selectrow_array;
my $empty_selectrow_arrayref;
my $empty_selectrow_hashref;
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $thr1 = threads->create('create_socket', 'unix');
#########################
# get a temp file from File::Temp and replace it with our socket
my $server = 'localhost:32987';
my $thr2 = threads->create('create_socket', 'inet');
sleep(1);
#########################
my $objects_to_test = {
# create unix object with hash args
'unix_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
socket => $socket_path,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create unix object with a single arg
'unix_single_arg' => Monitoring::Livestatus::UNIX->new( $socket_path ),
# create inet object with hash args
'inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $server,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create inet object with a single arg
'inet_single_arg' => Monitoring::Livestatus::INET->new( $server ),
};
for my $key (keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
##################################################
# test settings
my $rt = $ml->verbose(1);
is($rt, '0', 'enable verbose');
$rt = $ml->verbose(0);
is($rt, '1', 'disable verbose');
$rt = $ml->errors_are_fatal(0);
is($rt, '1', 'disable errors_are_fatal');
$rt = $ml->errors_are_fatal(1);
is($rt, '0', 'enable errors_are_fatal');
##################################################
# do some sample querys
my $statement = "GET hosts";
#########################
my $ary_ref = $ml->selectall_arrayref($statement);
is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
#########################
$ary_ref = $ml->selectall_arrayref($statement, { Slice => {} });
is_deeply($ary_ref, $selectall_arrayref2, 'selectall_arrayref($statement, { Slice => {} })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref2));
#########################
my $hash_ref = $ml->selectall_hashref($statement, 'name');
is_deeply($hash_ref, $selectall_hashref, 'selectall_hashref($statement, "name")')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectall_hashref));
#########################
$ary_ref = $ml->selectcol_arrayref($statement);
is_deeply($ary_ref, $selectcol_arrayref1, 'selectcol_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref1));
#########################
$ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2] });
is_deeply($ary_ref, $selectcol_arrayref2, 'selectcol_arrayref($statement, { Columns=>[1,2] })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref2));
$ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2,3] });
is_deeply($ary_ref, $selectcol_arrayref3, 'selectcol_arrayref($statement, { Columns=>[1,2,3] })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref3));
#########################
my @row_ary = $ml->selectrow_array($statement);
is_deeply(\@row_ary, \@selectrow_array, 'selectrow_array($statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@selectrow_array));
#########################
$ary_ref = $ml->selectrow_arrayref($statement);
is_deeply($ary_ref, $selectrow_arrayref, 'selectrow_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectrow_arrayref));
#########################
$hash_ref = $ml->selectrow_hashref($statement);
is_deeply($hash_ref, $selectrow_hashref, 'selectrow_hashref($statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectrow_hashref));
##################################################
# stats querys
##################################################
$ary_ref = $ml->selectall_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectall_arrayref1, 'selectall_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref1));
$ary_ref = $ml->selectall_arrayref($stats_statement, { Slice => {} });
is_deeply($ary_ref, $stats_selectall_arrayref2, 'selectall_arrayref($stats_statement, { Slice => {} })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref2));
$ary_ref = $ml->selectcol_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectcol_arrayref, 'selectcol_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectcol_arrayref));
@row_ary = $ml->selectrow_array($stats_statement);
is_deeply(\@row_ary, \@stats_selectrow_array, 'selectrow_arrayref($stats_statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@stats_selectrow_array));
$ary_ref = $ml->selectrow_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectrow_arrayref, 'selectrow_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectrow_arrayref));
$hash_ref = $ml->selectrow_hashref($stats_statement);
is_deeply($hash_ref, $stats_selectrow_hashref, 'selectrow_hashref($stats_statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($stats_selectrow_hashref));
my $scal = $ml->selectscalar_value($single_statement);
is($scal, $selectscalar_value, 'selectscalar_value($single_statement)')
or diag("got: ".Dumper($scal)."\nbut expected ".Dumper($selectscalar_value));
##################################################
# empty querys
##################################################
$ary_ref = $ml->selectall_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectall_arrayref, 'selectall_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectall_arrayref));
$ary_ref = $ml->selectcol_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectcol_arrayref, 'selectcol_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectcol_arrayref));
@row_ary = $ml->selectrow_array($empty_statement);
is_deeply(\@row_ary, \@empty_selectrow_array, 'selectrow_arrayref($empty_statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@empty_selectrow_array));
$ary_ref = $ml->selectrow_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectrow_arrayref, 'selectrow_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectrow_arrayref));
$hash_ref = $ml->selectrow_hashref($empty_statement);
is_deeply($hash_ref, $empty_selectrow_hashref, 'selectrow_hashref($empty_statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($empty_selectrow_hashref));
##################################################
# empty rows and columns
##################################################
my $empty_hostgroups_stm = "GET hostgroups\nColumns: members";
$ary_ref = $ml->selectall_arrayref($empty_hostgroups_stm);
is_deeply($ary_ref, $test_hostgroups, 'selectall_arrayref($empty_hostgroups_stm)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($test_hostgroups));
}
##################################################
# exit threads
$thr1->kill('KILL')->detach();
$thr2->kill('KILL')->detach();
exit;
#########################
# SUBS
#########################
# test socket server
sub create_socket {
my $type = shift;
my $listener;
$SIG{'KILL'} = sub { threads->exit(); };
if($type eq 'unix') {
print "creating unix socket\n";
$listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
}
elsif($type eq 'inet') {
print "creating tcp socket\n";
$listener = IO::Socket::INET->new(
LocalAddr => $server,
Proto => 'tcp',
Listen => 1,
Reuse => 1,
) or die("failed to listen on $server: $!");
} else {
die("unknown type");
}
while( my $socket = $listener->accept() or die('cannot accept: $!') ) {
my $recv = "";
while(<$socket>) { $recv .= $_; last if $_ eq "\n" }
my $data;
my $status = 200;
if($recv =~ m/^GET .*?\s+Filter:.*?empty/m) {
$data = '';
}
elsif($recv =~ m/^GET hosts\s+Columns: alias/m) {
my @data = @{$test_data}[1..3];
$data = encode_json(\@data)."\n";
}
elsif($recv =~ m/^GET hosts\s+Columns: name/m) {
$data = encode_json(\@{$test_data}[1..3])."\n";
}
elsif($recv =~ m/^GET hosts/) {
$data = encode_json($test_data)."\n";
}
elsif($recv =~ m/^GET hostgroups/) {
$data = encode_json(\@{$test_hostgroups})."\n";
}
elsif($recv =~ m/^GET services/ and $recv =~ m/Stats:/m) {
$data = encode_json(\@{$stats_data})."\n";
}
my $content_length = sprintf("%11s", length($data));
print $socket $status." ".$content_length."\n";
print $socket $data;
close($socket);
}
unlink($socket_path);
}

30
api/perl/t/21-Monitoring-Livestatus-INET.t Normal file
View File

@@ -0,0 +1,30 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More tests => 3;
use IO::Socket::INET;
BEGIN { use_ok('Monitoring::Livestatus::INET') };
#########################
# create a tmp listener
my $server = 'localhost:9999';
my $listener = IO::Socket::INET->new(
) or die("failed to open port as test listener: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus::INET->new( $server );
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus::INET->new(
verbose => 0,
server => $server,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new(%args)');

26
api/perl/t/22-Monitoring-Livestatus-UNIX.t Normal file
View File

@@ -0,0 +1,26 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More tests => 3;
use IO::Socket::INET;
BEGIN { use_ok('Monitoring::Livestatus::UNIX') };
#########################
# create object with single arg
my $socket = "/tmp/blah.socket";
my $ml = Monitoring::Livestatus::UNIX->new( $socket );
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus::UNIX->new(
verbose => 0,
socket => $socket,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new(%args)');

472
api/perl/t/30-Monitoring-Livestatus-live-test.t Normal file
View File

@@ -0,0 +1,472 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 727 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
print STDERR 'last query: '.$lastquery if defined $lastquery;
die "timeout reached:".Dumper(\@caller)."\n"
};
alarm(120);
use_ok('Monitoring::Livestatus');
#########################
my $line_seperator = 10;
my $column_seperator = 0;
my $objects_to_test = {
# UNIX
# create unix object with a single arg
# '01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ),
# create unix object with hash args
'02 unix_few_args' => Monitoring::Livestatus->new(
#verbose => 1,
socket => $ENV{TEST_SOCKET},
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create unix object with hash args
'03 unix_keepalive' => Monitoring::Livestatus->new(
verbose => 0,
socket => $ENV{TEST_SOCKET},
keepalive => 1,
),
# TCP
# create inet object with a single arg
'04 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
# create inet object with hash args
'05 inet_few_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create inet object with keepalive
'06 inet_keepalive' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
),
# create multi single args
'07 multi_keepalive' => Monitoring::Livestatus->new( [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ] ),
# create multi object with keepalive
'08 multi_keepalive_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
keepalive => 1,
),
# create multi object without keepalive
'09 multi_no_keepalive' => Monitoring::Livestatus->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
keepalive => 0,
),
# create multi object without threads
'10 multi_no_threads' => Monitoring::Livestatus->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
use_threads => 0,
),
# create multi object with only one peer
'11 multi_one_peer' => Monitoring::Livestatus::MULTI->new(
peer => $ENV{TEST_SERVER},
),
# create multi object without threads
'12 multi_two_peers' => Monitoring::Livestatus::MULTI->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
),
};
my $expected_keys = {
'columns' => [
'description','name','table','type'
],
'commands' => [
'line','name'
],
'comments' => [
'__all_from_hosts__', '__all_from_services__',
'author','comment','entry_time','entry_type','expire_time','expires', 'id','persistent',
'source','type'
],
'contacts' => [
'address1','address2','address3','address4','address5','address6','alias',
'can_submit_commands','custom_variable_names','custom_variable_values','email',
'host_notification_period','host_notifications_enabled','in_host_notification_period',
'in_service_notification_period','name','modified_attributes','modified_attributes_list',
'pager','service_notification_period','service_notifications_enabled'
],
'contactgroups' => [ 'name', 'alias', 'members' ],
'downtimes' => [
'__all_from_hosts__', '__all_from_services__',
'author','comment','duration','end_time','entry_time','fixed','id','start_time',
'triggered_by','type'
],
'hostgroups' => [
'action_url','alias','members','name','members_with_state','notes','notes_url','num_hosts','num_hosts_down',
'num_hosts_pending','num_hosts_unreach','num_hosts_up','num_services','num_services_crit',
'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown',
'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown',
'num_services_warn','worst_host_state','worst_service_hard_state','worst_service_state'
],
'hosts' => [
'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded',
'active_checks_enabled','address','alias','check_command','check_freshness','check_interval',
'check_options','check_period','check_type','checks_enabled','childs','comments','comments_with_info',
'contacts','current_attempt','current_notification_number','custom_variable_names',
'custom_variable_values','display_name','downtimes','downtimes_with_info','event_handler_enabled',
'execution_time','first_notification_delay','flap_detection_enabled','groups','hard_state','has_been_checked',
'high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period',
'in_notification_period','initial_state','is_executing','is_flapping','last_check','last_hard_state',
'last_hard_state_change','last_notification','last_state','last_state_change','latency','last_time_down',
'last_time_unreachable','last_time_up','long_plugin_output','low_flap_threshold','max_check_attempts','name',
'modified_attributes','modified_attributes_list','next_check',
'next_notification','notes','notes_expanded','notes_url','notes_url_expanded','notification_interval',
'notification_period','notifications_enabled','num_services','num_services_crit','num_services_hard_crit',
'num_services_hard_ok','num_services_hard_unknown','num_services_hard_warn','num_services_ok',
'num_services_pending','num_services_unknown','num_services_warn','obsess_over_host','parents',
'pending_flex_downtime','percent_state_change','perf_data','plugin_output',
'process_performance_data','retry_interval','scheduled_downtime_depth','services','services_with_state',
'state','state_type','statusmap_image','total_services','worst_service_hard_state','worst_service_state',
'x_3d','y_3d','z_3d'
],
'hostsbygroup' => [
'__all_from_hosts__', '__all_from_hostgroups__'
],
'log' => [
'__all_from_hosts__','__all_from_services__','__all_from_contacts__','__all_from_commands__',
'attempt','class','command_name','comment','contact_name','host_name','lineno','message','options',
'plugin_output','service_description','state','state_type','time','type'
],
'servicegroups' => [
'action_url','alias','members','name','members_with_state','notes','notes_url','num_services','num_services_crit',
'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown',
'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown',
'num_services_warn','worst_service_state'
],
'servicesbygroup' => [
'__all_from_services__', '__all_from_hosts__', '__all_from_servicegroups__'
],
'services' => [
'__all_from_hosts__',
'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded',
'active_checks_enabled','check_command','check_interval','check_options','check_period',
'check_type','checks_enabled','comments','comments_with_info','contacts','current_attempt',
'current_notification_number','custom_variable_names','custom_variable_values',
'description','display_name','downtimes','downtimes_with_info','event_handler','event_handler_enabled',
'execution_time','first_notification_delay','flap_detection_enabled','groups',
'has_been_checked','high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period',
'in_notification_period','initial_state','is_executing','is_flapping','last_check',
'last_hard_state','last_hard_state_change','last_notification','last_state',
'last_state_change','latency','last_time_critical','last_time_ok','last_time_unknown','last_time_warning',
'long_plugin_output','low_flap_threshold','max_check_attempts','modified_attributes','modified_attributes_list',
'next_check','next_notification','notes','notes_expanded','notes_url','notes_url_expanded',
'notification_interval','notification_period','notifications_enabled','obsess_over_service',
'percent_state_change','perf_data','plugin_output','process_performance_data','retry_interval',
'scheduled_downtime_depth','state','state_type'
],
'servicesbyhostgroup' => [
'__all_from_services__', '__all_from_hosts__', '__all_from_hostgroups__'
],
'status' => [
'accept_passive_host_checks','accept_passive_service_checks','cached_log_messages',
'check_external_commands','check_host_freshness','check_service_freshness','connections',
'connections_rate','enable_event_handlers','enable_flap_detection','enable_notifications',
'execute_host_checks','execute_service_checks','forks','forks_rate','host_checks','host_checks_rate','interval_length',
'last_command_check','last_log_rotation','livestatus_version','log_messages','log_messages_rate','nagios_pid','neb_callbacks',
'neb_callbacks_rate','obsess_over_hosts','obsess_over_services','process_performance_data',
'program_start','program_version','requests','requests_rate','service_checks','service_checks_rate'
],
'timeperiods' => [ 'in', 'name', 'alias' ],
};
my $author = 'Monitoring::Livestatus test';
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key);
# dont die on errors
$ml->errors_are_fatal(0);
$ml->warnings(0);
#########################
# set downtime for a host and service
my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id");
my $num_downtimes = 0;
$num_downtimes = scalar @{$downtimes} if defined $downtimes;
my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1");
isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname');
$ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0);
my $firstservice = $ml->selectscalar_value("GET services\nColumns: description\nFilter: host_name = $firsthost\nLimit: 1");
isnt($firstservice, undef, 'get test servicename') or BAIL_OUT('got not test servicename');
$ml->do('COMMAND ['.time().'] SCHEDULE_SVC_DOWNTIME;'.$firsthost.';'.$firstservice.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0);
# sometimes it takes while till the downtime is accepted
my $waited = 0;
while(scalar @{$ml->selectall_arrayref("GET downtimes\nColumns: id")} < $num_downtimes + 2) {
print "waiting for the downtime...\n";
sleep(1);
$waited++;
BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30;
}
#########################
#########################
# check tables
my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table');
my @tables = sort keys %{$data};
my @expected_tables = sort keys %{$expected_keys};
is_deeply(\@tables, \@expected_tables, $key.' tables') or BAIL_OUT("got tables:\n".join(', ', @tables)."\nbut expected\n".join(', ', @expected_tables));
#########################
# check keys
for my $type (keys %{$expected_keys}) {
my $filter = "";
$filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log';
$filter .= "Filter: time < ".(time())."\n" if $type eq 'log';
my $expected_keys = get_expected_keys($type);
my $statement = "GET $type\n".$filter."Limit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is(ref $hash_ref, 'HASH', $type.' keys are a hash') or BAIL_OUT($type.'keys are not in hash format, got '.Dumper($hash_ref));
my @keys = sort keys %{$hash_ref};
is_deeply(\@keys, $expected_keys, $key.' '.$type.' table columns') or BAIL_OUT("got $type keys:\n".join(', ', @keys)."\nbut expected\n".join(', ', @{$expected_keys}));
}
my $statement = "GET hosts\nColumns: name as hostname state\nLimit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement);
undef $lastquery;
isnt($hash_ref, undef, $key.' test column alias');
is($Monitoring::Livestatus::ErrorCode, 0, $key.' test column alias') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# send a test command
# commands still dont work and breaks livestatus
my $rt = $ml->do('COMMAND ['.time().'] SAVE_STATE_INFORMATION');
is($rt, '1', $key.' test command');
#########################
# check for errors
#$ml->{'verbose'} = 1;
$statement = "GET hosts\nLimit: 1";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
isnt($hash_ref, undef, $key.' test error 200 body');
is($Monitoring::Livestatus::ErrorCode, 0, $key.' test error 200 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "BLAH hosts";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 401 body');
is($Monitoring::Livestatus::ErrorCode, '401', $key.' test error 401 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nLimit: ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 403 body');
is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET unknowntable\nLimit: 1";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 404 body');
is($Monitoring::Livestatus::ErrorCode, '404', $key.' test error 404 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: unknown";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
TODO: {
local $TODO = 'livestatus returns wrong status';
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
};
#########################
# some more broken statements
$statement = "GET ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement);
undef $lastquery;
is($hash_ref, undef, $key.' test error 403 body');
is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status: GET ') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: name, name";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: name, name') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: ') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# some forbidden headers
$statement = "GET hosts\nKeepAlive: on";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 496 body');
is($Monitoring::Livestatus::ErrorCode, '496', $key.' test error 496 status: KeepAlive: on') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nResponseHeader: fixed16";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 495 body');
is($Monitoring::Livestatus::ErrorCode, '495', $key.' test error 495 status: ResponseHeader: fixed16') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumnHeaders: on";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 494 body');
is($Monitoring::Livestatus::ErrorCode, '494', $key.' test error 494 status: ColumnHeader: on') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nOuputFormat: json";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 493 body');
is($Monitoring::Livestatus::ErrorCode, '493', $key.' test error 493 status: OutputForma: json') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nSeparators: 0 1 2 3";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 492 body');
is($Monitoring::Livestatus::ErrorCode, '492', $key.' test error 492 status: Seperators: 0 1 2 3') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# check some fancy stats queries
my $stats_query = "GET services
Stats: state = 0 as all_ok
Stats: state = 1 as all_warning
Stats: state = 2 as all_critical
Stats: state = 3 as all_unknown
Stats: state = 4 as all_pending
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2 as all_warning_on_down_hosts
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2 as all_critical_on_down_hosts
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2 as all_unknown_on_down_hosts
Stats: host_state != 0
Stats: state = 3
Stats: active_checks_enabled = 1
StatsAnd: 3 as all_unknown_active_on_down_hosts
Stats: state = 3
Stats: active_checks_enabled = 1
StatsOr: 2 as all_active_or_unknown";
$lastquery = $stats_query;
$hash_ref = $ml->selectrow_hashref($stats_query );
undef $lastquery;
isnt($hash_ref, undef, $key.' test fancy stats query') or
diag('got error: '.Dumper($hash_ref));
}
# generate expected keys
sub get_expected_keys {
my $type = shift;
my $skip = shift;
my @keys = @{$expected_keys->{$type}};
my @new_keys;
for my $key (@keys) {
my $replaced = 0;
for my $replace_with (keys %{$expected_keys}) {
if($key eq '__all_from_'.$replace_with.'__') {
$replaced = 1;
next if $skip;
my $prefix = $replace_with.'_';
if($replace_with eq "hosts") { $prefix = 'host_'; }
if($replace_with eq "services") { $prefix = 'service_'; }
if($replace_with eq "commands") { $prefix = 'command_'; }
if($replace_with eq "contacts") { $prefix = 'contact_'; }
if($replace_with eq "servicegroups") { $prefix = 'servicegroup_'; }
if($replace_with eq "hostgroups") { $prefix = 'hostgroup_'; }
if($type eq "log") { $prefix = 'current_'.$prefix; }
if($type eq "servicesbygroup" and $replace_with eq 'services') { $prefix = ''; }
if($type eq "servicesbyhostgroup" and $replace_with eq 'services') { $prefix = ''; }
if($type eq "hostsbygroup" and $replace_with eq 'hosts') { $prefix = ''; }
my $replace_keys = get_expected_keys($replace_with, 1);
for my $key2 (@{$replace_keys}) {
push @new_keys, $prefix.$key2;
}
}
}
if($replaced == 0) {
push @new_keys, $key;
}
}
# has been fixed in 1.1.1rc
#if($type eq 'log') {
# my %keys = map { $_ => 1 } @new_keys;
# delete $keys{'current_contact_can_submit_commands'};
# delete $keys{'current_contact_host_notifications_enabled'};
# delete $keys{'current_contact_in_host_notification_period'};
# delete $keys{'current_contact_in_service_notification_period'};
# delete $keys{'current_contact_service_notifications_enabled'};
# @new_keys = keys %keys;
#}
my @return = sort @new_keys;
return(\@return);
}

95
api/perl/t/31-Monitoring-Livestatus-MULTI-live-test.t Normal file
View File

@@ -0,0 +1,95 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 22 );
}
use_ok('Monitoring::Livestatus::MULTI');
#########################
# create new test object
my $objects_to_test = {
'multi_one' => Monitoring::Livestatus::MULTI->new( peer => [ $ENV{TEST_SERVER} ], warnings => 0 ),
'multi_two' => Monitoring::Livestatus::MULTI->new( peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ], warnings => 0 ),
'multi_three' => Monitoring::Livestatus::MULTI->new(
'verbose' => '0',
'warnings' => '0',
'timeout' => '10',
'peer' => [
{ 'name' => 'Mon 1', 'peer' => $ENV{TEST_SERVER} },
{ 'name' => 'Mon 2', 'peer' => $ENV{TEST_SOCKET} },
],
'keepalive' => '1'
),
};
# dont die on errors
#$ml->errors_are_fatal(0);
for my $key (keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus::MULTI') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus::MULTI object");
#########################
# DATA INTEGRITY
#########################
my $statement = "GET hosts\nColumns: state name alias\nLimit: 1";
my $data1 = $ml->selectall_arrayref($statement, {Slice => 1});
my $data2 = $ml->selectall_arrayref($statement, {Slice => 1, AddPeer => 1});
for my $data (@{$data2}) {
delete $data->{'peer_name'};
delete $data->{'peer_addr'};
delete $data->{'peer_key'};
}
is_deeply($data1, $data2, "data integrity with peers added and Column");
$statement = "GET hosts\nLimit: 1";
$data1 = $ml->selectall_arrayref($statement, {Slice => 1, Deepcopy => 1});
$data2 = $ml->selectall_arrayref($statement, {Slice => 1, AddPeer => 1, Deepcopy => 1});
for my $data (@{$data2}) {
delete $data->{'peer_name'};
delete $data->{'peer_addr'};
delete $data->{'peer_key'};
}
is_deeply($data1, $data2, "data integrity with peers added without Columns");
#########################
# try to change result set to scalar
for my $data (@{$data1}) { $data->{'peer_name'} = 1; }
for my $data (@{$data2}) { $data->{'peer_name'} = 1; }
is_deeply($data1, $data2, "data integrity with changed result set");
#########################
# try to change result set to hash
for my $data (@{$data1}) { $data->{'peer_name'} = {}; }
for my $data (@{$data2}) { $data->{'peer_name'} = {}; }
is_deeply($data1, $data2, "data integrity with changed result set");
#########################
# BACKENDS
#########################
my @backends = $ml->peer_key();
$data1 = $ml->selectall_arrayref($statement, {Slice => 1});
$data2 = $ml->selectall_arrayref($statement, {Slice => 1, Backend => \@backends });
is_deeply($data1, $data2, "data integrity with backends");
#########################
# BUGS
#########################
#########################
# Bug: Can't use string ("flap") as an ARRAY ref while "strict refs" in use at Monitoring/Livestatus/MULTI.pm line 206.
$statement = "GET servicegroups\nColumns: name alias\nFilter: name = flap\nLimit: 1";
$data1 = $ml->selectrow_array($statement);
isnt($data1, undef, "bug check: Can't use string (\"group\")...");
}

106
api/perl/t/32-Monitoring-Livestatus-backend-test.t Normal file
View File

@@ -0,0 +1,106 @@
#!/usr/bin/env perl
#########################
use strict;
use Carp;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} or !defined $ENV{TEST_BACKEND} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} and $ENV{TEST_BACKEND} to run';
plan( skip_all => $msg );
} else {
# we dont know yet how many tests we got
plan( tests => 55237 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
$lastquery =~ s/\n+/\n/g;
print STDERR 'last query: '.$lastquery."\n" if defined $lastquery;
confess "timeout reached:".Dumper(\@caller)."\n"
};
use_ok('Monitoring::Livestatus');
#########################
my $objects_to_test = {
# UNIX
'01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ),
# TCP
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
# MULTI
'03 multi_keepalive' => Monitoring::Livestatus->new( [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ] ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key);
# dont die on errors
$ml->errors_are_fatal(0);
$ml->warnings(0);
#########################
# get tables
my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table');
my @tables = sort keys %{$data};
#########################
# check keys
for my $type (@tables) {
alarm(120);
my $filter = "";
$filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log';
$filter .= "Filter: time < ".(time())."\n" if $type eq 'log';
my $statement = "GET $type\n".$filter."Limit: 1";
$lastquery = $statement;
my $keys = $ml->selectrow_hashref($statement );
undef $lastquery;
is(ref $keys, 'HASH', $type.' keys are a hash');# or BAIL_OUT('keys are not in hash format, got '.Dumper($keys));
# status has no filter implemented
next if $type eq 'status';
for my $key (keys %{$keys}) {
my $value = $keys->{$key};
if(index($value, ',') > 0) { my @vals = split /,/, $value; $value = $vals[0]; }
my $typefilter = "Filter: $key >= $value\n";
if($value eq '') {
$typefilter = "Filter: $key =\n";
}
my $statement = "GET $type\n".$filter.$typefilter."Limit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value) or BAIL_OUT("query failed: ".$statement);
#isnt($hash_ref, undef, "GET ".$type." Filter: ".$key." >= ".$value);# or BAIL_OUT("got undef for ".$statement);
# send test stats query
my $stats_query = [ $key.' = '.$value, 'std '.$key, 'min '.$key, 'max '.$key, 'avg '.$key, 'sum '.$key ];
for my $stats_part (@{$stats_query}) {
my $statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part") or BAIL_OUT("query failed:\n".$statement);
$statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part\nStatsGroupBy: $key";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part StatsGroupBy: $key") or BAIL_OUT("query failed:\n".$statement);
}
# wait till backend is started up again
if(!defined $hash_ref and $Monitoring::Livestatus::ErrorCode > 200) {
sleep(2);
}
}
}
}

74
api/perl/t/33-Monitoring-Livestatus-test_socket_timeout.t Normal file
View File

@@ -0,0 +1,74 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 7 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
print STDERR 'last query: '.$lastquery if defined $lastquery;
die "timeout reached:".Dumper(\@caller)."\n"
};
alarm(30);
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
# Test Query
#########################
my $statement = "GET hosts\nColumns: alias\nFilter: name = host1";
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
#########################
my $ary_ref = $ml->selectall_arrayref($statement);
is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0');
#is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
# or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
sleep(10);
$ary_ref = $ml->selectall_arrayref($statement);
is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0');
#is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
# or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
#print Dumper($Monitoring::Livestatus::ErrorCode);
#print Dumper($Monitoring::Livestatus::ErrorMessage);
}

78
api/perl/t/34-Monitoring-Livestatus-utf8_support.t Normal file
View File

@@ -0,0 +1,78 @@
#!/usr/bin/env perl
#########################
use strict;
use Encode;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 9 );
}
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
my $author = 'Monitoring::Livestatus test';
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
#########################
my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id");
my $num_downtimes = 0;
$num_downtimes = scalar @{$downtimes} if defined $downtimes;
#########################
# get a test host
my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1");
isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname');
my $expect = "aa ²&é\"'''(§è!çà)- %s ''%s'' aa ~ € bb";
#my $expect = "öäüß";
my $teststrings = [
$expect,
"aa \x{c2}\x{b2}&\x{c3}\x{a9}\"'''(\x{c2}\x{a7}\x{c3}\x{a8}!\x{c3}\x{a7}\x{c3}\x{a0})- %s ''%s'' aa ~ \x{e2}\x{82}\x{ac} bb",
];
for my $string (@{$teststrings}) {
$ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';'.$string);
# sometimes it takes while till the downtime is accepted
my $waited = 0;
while($downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id comment", { Slice => 1 }) and scalar @{$downtimes} < $num_downtimes + 1) {
print "waiting for the downtime...\n";
sleep(1);
$waited++;
BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30;
}
my $last_downtime = pop @{$downtimes};
#utf8::decode($expect);
is($last_downtime->{'comment'}, $expect, 'get same utf8 comment: got '.Dumper($last_downtime));
}
}

53
api/perl/t/35-Monitoring-Livestatus-callbacks_support.t Normal file
View File

@@ -0,0 +1,53 @@
#!/usr/bin/env perl
#########################
use strict;
use Encode;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 15 );
}
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
my $got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'c1' => sub { return $_[0]->{'alias'}; } } });
isnt($got->[0]->{'alias'}, undef, 'got a test host');
is($got->[0]->{'alias'}, $got->[0]->{'c1'}, 'callback for sliced results');
$got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'name' => sub { return $_[0]->{'alias'}; } } });
isnt($got->[0]->{'alias'}, undef, 'got a test host');
is($got->[0]->{'alias'}, $got->[0]->{'name'}, 'callback for sliced results which overwrites key');
$got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { callbacks => { 'c1' => sub { return $_[0]->[1]; } } });
isnt($got->[0]->[1], undef, 'got a test host');
is($got->[0]->[1], $got->[0]->[3], 'callback for non sliced results');
}

9
api/perl/t/97-Pod.t Normal file
View File

@@ -0,0 +1,9 @@
use strict;
use warnings;
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => 'Test::Pod 1.14 required' if $@;
plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.' unless $ENV{TEST_AUTHOR};
all_pod_files_ok();

23
api/perl/t/98-Pod-Coverage.t Normal file
View File

@@ -0,0 +1,23 @@
#!/usr/bin/env perl
#
# $Id$
#
use strict;
use warnings;
use File::Spec;
use Test::More;
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Pod::Coverage; };
if ( $@ ) {
my $msg = 'Test::Pod::Coverage required to criticise pod';
plan( skip_all => $msg );
}
eval "use Test::Pod::Coverage 1.00";
all_pod_coverage_ok();

24
api/perl/t/99-Perl-Critic.t Normal file
View File

@@ -0,0 +1,24 @@
#!/usr/bin/env perl
#
# $Id$
#
use strict;
use warnings;
use File::Spec;
use Test::More;
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ( $@ ) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();

286
api/perl/t/perlcriticrc Normal file
View File

@@ -0,0 +1,286 @@
##############################################################################
# This Perl::Critic configuration file sets the Policy severity levels
# according to Damian Conway's own personal recommendations. Feel free to
# use this as your own, or make modifications.
##############################################################################
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitAccessOfPrivateData]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock]
severity = 1
[Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit]
severity = 2
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock]
severity = 3
[Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading]
severity = 3
[Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA]
severity = 4
[Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless]
severity = 5
[Perl::Critic::Policy::CodeLayout::ProhibitHardTabs]
severity = 3
[Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins]
severity = 1
[Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists]
severity = 2
[Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines]
severity = 4
[Perl::Critic::Policy::CodeLayout::RequireTidyCode]
severity = 1
[Perl::Critic::Policy::CodeLayout::RequireTrailingCommas]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitDeepNests]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions]
severity = 5
[Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks]
severity = 4
[Perl::Critic::Policy::Documentation::RequirePodAtEnd]
severity = 2
[Perl::Critic::Policy::Documentation::RequirePodSections]
severity = 2
[Perl::Critic::Policy::ErrorHandling::RequireCarping]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators]
severity = 3
[Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles]
severity = 5
[Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop]
severity = 5
[Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen]
severity = 4
[Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint]
severity = 3
[Perl::Critic::Policy::Miscellanea::ProhibitFormats]
severity = 3
[Perl::Critic::Policy::Miscellanea::ProhibitTies]
severity = 4
[-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords]
[Perl::Critic::Policy::Modules::ProhibitAutomaticExportation]
severity = 4
[Perl::Critic::Policy::Modules::ProhibitEvilModules]
severity = 5
[Perl::Critic::Policy::Modules::ProhibitMultiplePackages]
severity = 4
[Perl::Critic::Policy::Modules::RequireBarewordIncludes]
severity = 5
[Perl::Critic::Policy::Modules::RequireEndWithOne]
severity = 4
[Perl::Critic::Policy::Modules::RequireExplicitPackage]
severity = 4
[Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage]
severity = 5
[Perl::Critic::Policy::Modules::RequireVersionVar]
severity = 4
[Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames]
severity = 3
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs]
severity = 1
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars]
severity = 1
[Perl::Critic::Policy::References::ProhibitDoubleSigils]
severity = 4
[Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest]
severity = 4
[Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting]
severity = 5
[Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching]
severity = 5
[Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils]
severity = 2
[Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms]
severity = 4
[Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity]
severity = 3
[Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef]
severity = 5
[Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes]
severity = 4
[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
severity = 3
[Perl::Critic::Policy::Subroutines::RequireFinalReturn]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings]
severity = 4
[Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride]
severity = 4
[Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels]
severity = 3
[Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals]
severity = 1
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros]
severity = 5
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings]
severity = 3
[Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars]
severity = 1
[Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
severity = 4
[Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations]
severity = 5
[Perl::Critic::Policy::Variables::ProhibitLocalVars]
severity = 2
[Perl::Critic::Policy::Variables::ProhibitMatchVars]
severity = 4
[Perl::Critic::Policy::Variables::ProhibitPackageVars]
severity = 3
[Perl::Critic::Policy::Variables::ProhibitPunctuationVars]
severity = 2
[Perl::Critic::Policy::Variables::ProtectPrivateVars]
severity = 3
[Perl::Critic::Policy::Variables::RequireInitializationForLocalVars]
severity = 5
[Perl::Critic::Policy::Variables::RequireLexicalLoopIterators]
severity = 5
[Perl::Critic::Policy::Variables::RequireNegativeIndices]
severity = 4