[Pkg-nagios-devel] Bug#849207: libmonitoring-livestatus-perl: Outdated packaging
Bas Couwenberg
sebastic at xs4all.nl
Fri Dec 23 13:49:48 UTC 2016
Source: libmonitoring-livestatus-perl
Version: 0.74-1
Severity: normal
Tags: patch
Dear Maintainer,
The packaging for libmonitoring-livestatus-perl is outdated as reported
by lintian. Amongst other the debhelper compatibility version is
outdated, the Standards-Version is ancient, and the latest upstream
release is not yet included.
The attached patches update the packaging to resolve this. These changes
could not be pushed to the git repository on Alioth because it doesn't
exist as reported in #849188.
Kind Regards,
Bas
-------------- next part --------------
>From 8b760464d34aa4e59932551ccd426b871c55b508 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:16:20 +0100
Subject: Update Vcs-Git URL to use HTTPS.
---
debian/changelog | 1 +
debian/control | 2 +-
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/debian/changelog b/debian/changelog
index 3209d7d..15c24b0 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Team upload.
* Restructure control file with cme.
+ * Update Vcs-Git URL to use HTTPS.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
diff --git a/debian/control b/debian/control
index 2601688..a197f21 100644
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Build-Depends-Indep: libjson-xs-perl,
perl
Standards-Version: 3.9.2
Vcs-Browser: https://anonscm.debian.org/cgit/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
-Vcs-Git: git://anonscm.debian.org/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
+Vcs-Git: https://anonscm.debian.org/git/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Homepage: http://search.cpan.org/dist/Monitoring-Livestatus/
Package: libmonitoring-livestatus-perl
--
2.1.4
-------------- next part --------------
>From 01e7b16515160c4f39633dc91c80345254a436b7 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:22:01 +0100
Subject: Update copyright file using copyright-format 1.0.
---
debian/changelog | 1 +
debian/copyright | 6 +++---
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index db58df7..1a62bf1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Restructure control file with cme.
* Update Vcs-Git URL to use HTTPS.
* Use metacpan.org instead of search.cpan.org.
+ * Update copyright file using copyright-format 1.0.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
diff --git a/debian/copyright b/debian/copyright
index 759fa60..58c1fc9 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,7 +1,7 @@
-Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
-Maintainer: Sven Nierlein, <nierlein at cpan.org>
+Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
+Upstream-Name: Monitoring-Livestatus
+Upstream-Contact: Sven Nierlein, <nierlein at cpan.org>
Source: https://metacpan.org/release/Monitoring-Livestatus
-Name: Monitoring-Livestatus
Files: *
Copyright: Sven Nierlein, <nierlein at cpan.org>
--
2.1.4
-------------- next part --------------
>From 09474bbeffc179d1885dc3fa0394c518dfd99a40 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:23:14 +0100
Subject: Enable parallel builds.
---
debian/changelog | 1 +
debian/rules | 2 +-
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/debian/changelog b/debian/changelog
index 523e453..cb14cae 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Use metacpan.org instead of search.cpan.org.
* Update copyright file using copyright-format 1.0.
* Bump debhelper compatibility to 9.
+ * Enable parallel builds.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
diff --git a/debian/rules b/debian/rules
index 2d33f6a..ce2eb52 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,4 +1,4 @@
#!/usr/bin/make -f
%:
- dh $@
+ dh $@ --parallel
--
2.1.4
-------------- next part --------------
>From 13249bc2ca6d929957cadd653f0dca7e849e76b1 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:28:15 +0100
Subject: New upstream release.
---
debian/changelog | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index cb14cae..c8f1ca7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,7 @@
-libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
+libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Team upload.
+ * New upstream release.
* Restructure control file with cme.
* Update Vcs-Git URL to use HTTPS.
* Use metacpan.org instead of search.cpan.org.
@@ -8,7 +9,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Bump debhelper compatibility to 9.
* Enable parallel builds.
- -- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
+ -- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
libmonitoring-livestatus-perl (0.74-1) unstable; urgency=low
--
2.1.4
-------------- next part --------------
>From 583c72cae872a02bfe7110729ed9b7b95719bacb Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 13:54:21 +0100
Subject: Add patch to fix testfile existence test.
---
debian/changelog | 1 +
...ailing-testfile-tmp-testresult.json.data-writte.patch | 16 ++++++++++++++++
debian/patches/series | 1 +
3 files changed, 18 insertions(+)
create mode 100644 debian/patches/0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch
create mode 100644 debian/patches/series
diff --git a/debian/changelog b/debian/changelog
index 71b9ac3..f8e0b93 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,6 +9,7 @@ libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Bump debhelper compatibility to 9.
* Enable parallel builds.
* Switch to source format 3.0 (quilt).
+ * Add patch to fix testfile existence test.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
diff --git a/debian/patches/0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch b/debian/patches/0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch
new file mode 100644
index 0000000..7ff083f
--- /dev/null
+++ b/debian/patches/0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch
@@ -0,0 +1,16 @@
+Description: Fix failing "testfile: /tmp/testresult.json.data written" tests
+Author: Kivanc Yazan <kivancyazan at gmail.com>
+Origin: https://github.com/sni/Monitoring-Livestatus/commit/77e991e7a99f2e42f58a6160318cee657af4de44
+Bug: https://github.com/sni/Monitoring-Livestatus/pull/4
+
+--- a/t/23-Monitoring-Livestatus-BigData.t
++++ b/t/23-Monitoring-Livestatus-BigData.t
+@@ -24,7 +24,7 @@ for my $x (1..$testresults) {
+ }
+ print $fh "]\n";
+ close($fh);
+-ok(-f $testfile, "testfile: ".$testfile.".data written");
++ok(-f $testfile.".data", "testfile: ".$testfile.".data written");
+
+ chomp(my $size = `du -h $testfile.data`);
+ ok($size, $size);
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..40dd9fa
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1 @@
+0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch
--
2.1.4
-------------- next part --------------
>From 9e4229312af35464f8c37164edf47ed76a2c6148 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 14:14:21 +0100
Subject: Add patch to fix spelling errors.
---
debian/changelog | 1 +
debian/patches/series | 1 +
debian/patches/spelling-errors.patch | 291 +++++++++++++++++++++++++++++++++++
3 files changed, 293 insertions(+)
create mode 100644 debian/patches/spelling-errors.patch
diff --git a/debian/changelog b/debian/changelog
index a88725e..aba82d4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -11,6 +11,7 @@ libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Switch to source format 3.0 (quilt).
* Add patch to fix testfile existence test.
* Add build dependencies on procps & netcat for tests.
+ * Add patch to fix spelling errors.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
diff --git a/debian/patches/series b/debian/patches/series
index 40dd9fa..9748041 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -1 +1,2 @@
0001-Fix-failing-testfile-tmp-testresult.json.data-writte.patch
+spelling-errors.patch
diff --git a/debian/patches/spelling-errors.patch b/debian/patches/spelling-errors.patch
new file mode 100644
index 0000000..d19f9a0
--- /dev/null
+++ b/debian/patches/spelling-errors.patch
@@ -0,0 +1,291 @@
+Description: Fix spelling errors.
+ * seperator -> separator
+ * dont -> don't
+Author: Bas Couwenberg <sebastic at debian.org>
+Forwarded: https://github.com/sni/Monitoring-Livestatus/pull/5
+
+--- a/lib/Monitoring/Livestatus.pm
++++ b/lib/Monitoring/Livestatus.pm
+@@ -84,21 +84,21 @@ address
+
+ verbose mode
+
+-=item line_seperator
++=item line_separator
+
+-ascii code of the line seperator, defaults to 10, (newline)
++ascii code of the line separator, defaults to 10, (newline)
+
+-=item column_seperator
++=item column_separator
+
+-ascii code of the column seperator, defaults to 0 (null byte)
++ascii code of the column separator, defaults to 0 (null byte)
+
+-=item list_seperator
++=item list_separator
+
+-ascii code of the list seperator, defaults to 44 (comma)
++ascii code of the list separator, defaults to 44 (comma)
+
+-=item host_service_seperator
++=item host_service_separator
+
+-ascii code of the host/service seperator, defaults to 124 (pipe)
++ascii code of the host/service separator, defaults to 124 (pipe)
+
+ =item keepalive
+
+@@ -143,10 +143,10 @@ sub new {
+ 'server' => undef, # use tcp connections
+ 'peer' => undef, # use for socket / server connections
+ 'name' => undef, # human readable name
+- 'line_seperator' => 10, # defaults to newline
+- 'column_seperator' => 0, # defaults to null byte
+- 'list_seperator' => 44, # defaults to comma
+- 'host_service_seperator' => 124, # defaults to pipe
++ 'line_separator' => 10, # defaults to newline
++ 'column_separator' => 0, # defaults to null byte
++ 'list_separator' => 44, # defaults to comma
++ 'host_service_separator' => 124, # defaults to pipe
+ 'keepalive' => 0, # enable keepalive?
+ 'errors_are_fatal' => 1, # die on errors
+ 'backend' => undef, # should be keept undef, used internally
+@@ -160,6 +160,22 @@ sub new {
+ 'retry_interval' => 1, # retry after x seconds
+ };
+
++ my %old_key = (
++ line_seperator => 'line_separator',
++ column_seperator => 'column_separator',
++ list_seperator => 'list_separator',
++ host_service_seperator => 'host_service_separator',
++ );
++
++ # previous versions had spelling errors in the key name
++ for my $opt_key (keys %old_key) {
++ if(exists $options{$opt_key}) {
++ my $value = $options{$opt_key};
++ $options{ $old_key{$opt_key} } = $value;
++ delete $options{$opt_key};
++ }
++ }
++
+ for my $opt_key (keys %options) {
+ if(exists $self->{$opt_key}) {
+ $self->{$opt_key} = $options{$opt_key};
+@@ -1013,7 +1029,7 @@ useful when using multiple backends.
+ deep copy/clone the result set.
+
+ Only effective when using multiple backends and threads.
+- This can be safely turned off if you dont change the
++ This can be safely turned off if you don't change the
+ result set.
+ If you get an error like "Invalid value for shared scalar" error" this
+ should be turned on.
+@@ -1382,7 +1398,7 @@ sub _get_error {
+ '452' => 'internal livestatus error',
+ '490' => 'no query',
+ '491' => 'failed to connect',
+- '492' => 'Separators not allowed in statement. Please use the seperator options in new()',
++ '492' => 'Separators not allowed in statement. Please use the separator options in new()',
+ '493' => 'OuputFormat not allowed in statement. Header will be set automatically',
+ '494' => 'ColumnHeaders not allowed in statement. Header will be set automatically',
+ '495' => 'ResponseHeader not allowed in statement. Header will be set automatically',
+--- a/t/01-Monitoring-Livestatus-basic_tests.t
++++ b/t/01-Monitoring-Livestatus-basic_tests.t
+@@ -37,13 +37,13 @@ is($ml->peer_addr(), $socket_path, 'get
+
+ #########################
+ # create object with hash args
+-my $line_seperator = 10;
+-my $column_seperator = 0;
++my $line_separator = 10;
++my $column_separator = 0;
+ $ml = Monitoring::Livestatus->new(
+ verbose => 0,
+ socket => $socket_path,
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ );
+ isa_ok($ml, 'Monitoring::Livestatus', 'new hash args');
+ is($ml->peer_name(), $socket_path, 'get peer_name()');
+--- a/t/20-Monitoring-Livestatus-test_socket.t
++++ b/t/20-Monitoring-Livestatus-test_socket.t
+@@ -30,8 +30,8 @@ BEGIN { use_ok('Monitoring::Livestatus')
+ #########################
+ # Normal Querys
+ #########################
+-my $line_seperator = 10;
+-my $column_seperator = 0;
++my $line_separator = 10;
++my $column_separator = 0;
+ my $test_data = [ ["alias","name","contacts"], # table header
+ ["alias1","host1","contact1"], # row 1
+ ["alias2","host2","contact2"], # row 2
+@@ -112,8 +112,8 @@ my $objects_to_test = {
+ 'unix_hash_args' => Monitoring::Livestatus->new(
+ verbose => 0,
+ socket => $socket_path,
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ ),
+
+ # create unix object with a single arg
+@@ -123,8 +123,8 @@ my $objects_to_test = {
+ 'inet_hash_args' => Monitoring::Livestatus->new(
+ verbose => 0,
+ server => $server,
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ ),
+
+ # create inet object with a single arg
+@@ -136,7 +136,7 @@ for my $key (keys %{$objects_to_test}) {
+ my $ml = $objects_to_test->{$key};
+ isa_ok($ml, 'Monitoring::Livestatus');
+
+- # we dont need warnings for testing
++ # we don't need warnings for testing
+ $ml->warnings(0);
+
+ ##################################################
+--- a/t/21-Monitoring-Livestatus-INET.t
++++ b/t/21-Monitoring-Livestatus-INET.t
+@@ -19,12 +19,12 @@ isa_ok($ml, 'Monitoring::Livestatus', 'M
+
+ #########################
+ # create object with hash args
+-my $line_seperator = 10;
+-my $column_seperator = 0;
++my $line_separator = 10;
++my $column_separator = 0;
+ $ml = Monitoring::Livestatus::INET->new(
+ verbose => 0,
+ server => $server,
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ );
+ isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new(%args)');
+--- a/t/22-Monitoring-Livestatus-UNIX.t
++++ b/t/22-Monitoring-Livestatus-UNIX.t
+@@ -15,12 +15,12 @@ isa_ok($ml, 'Monitoring::Livestatus', 'M
+
+ #########################
+ # create object with hash args
+-my $line_seperator = 10;
+-my $column_seperator = 0;
++my $line_separator = 10;
++my $column_separator = 0;
+ $ml = Monitoring::Livestatus::UNIX->new(
+ verbose => 0,
+ socket => $socket,
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ );
+ isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new(%args)');
+--- a/t/30-Monitoring-Livestatus-live-test.t
++++ b/t/30-Monitoring-Livestatus-live-test.t
+@@ -27,8 +27,8 @@ use_ok('Monitoring::Livestatus::INET');
+ use_ok('Monitoring::Livestatus::UNIX');
+
+ #########################
+-my $line_seperator = 10;
+-my $column_seperator = 0;
++my $line_separator = 10;
++my $column_separator = 0;
+ my $objects_to_test = {
+ # UNIX
+ # create unix object with a single arg
+@@ -38,8 +38,8 @@ my $objects_to_test = {
+ '02 unix_few_args' => Monitoring::Livestatus->new(
+ #verbose => 1,
+ socket => $ENV{TEST_SOCKET},
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ ),
+
+ # create unix object with hash args
+@@ -57,8 +57,8 @@ my $objects_to_test = {
+ '05 inet_few_args' => Monitoring::Livestatus->new(
+ verbose => 0,
+ server => $ENV{TEST_SERVER},
+- line_seperator => $line_seperator,
+- column_seperator => $column_seperator,
++ line_separator => $line_separator,
++ column_separator => $column_separator,
+ ),
+
+
+@@ -179,7 +179,7 @@ for my $key (sort keys %{$objects_to_tes
+ 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
++ # don't die on errors
+ $ml->errors_are_fatal(0);
+ $ml->warnings(0);
+
+@@ -238,7 +238,7 @@ for my $key (sort keys %{$objects_to_tes
+
+ #########################
+ # send a test command
+- # commands still dont work and breaks livestatus
++ # commands still don't work and breaks livestatus
+ my $rt = $ml->do('COMMAND ['.time().'] SAVE_STATE_INFORMATION');
+ is($rt, '1', $key.' test command');
+
+--- a/t/32-Monitoring-Livestatus-backend-test.t
++++ b/t/32-Monitoring-Livestatus-backend-test.t
+@@ -11,7 +11,7 @@ if ( ! defined $ENV{TEST_SOCKET} or !def
+ 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
++ # we don't know yet how many tests we got
+ plan( tests => 57070 );
+ }
+
+@@ -39,7 +39,7 @@ for my $key (sort keys %{$objects_to_tes
+ 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
++ # don't die on errors
+ $ml->errors_are_fatal(0);
+ $ml->warnings(0);
+
+--- a/t/33-Monitoring-Livestatus-test_socket_timeout.t
++++ b/t/33-Monitoring-Livestatus-test_socket_timeout.t
+@@ -53,7 +53,7 @@ for my $key (sort keys %{$objects_to_tes
+ my $ml = $objects_to_test->{$key};
+ isa_ok($ml, 'Monitoring::Livestatus');
+
+- # we dont need warnings for testing
++ # we don't need warnings for testing
+ $ml->warnings(0);
+
+ #########################
+--- a/t/34-Monitoring-Livestatus-utf8_support.t
++++ b/t/34-Monitoring-Livestatus-utf8_support.t
+@@ -44,7 +44,7 @@ for my $key (sort keys %{$objects_to_tes
+ my $ml = $objects_to_test->{$key};
+ isa_ok($ml, 'Monitoring::Livestatus');
+
+- # we dont need warnings for testing
++ # we don't need warnings for testing
+ $ml->warnings(0);
+
+ #########################
--
2.1.4
-------------- next part --------------
>From b9924b5b5c327c6020f5aeb7a51692fffc062100 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:15:53 +0100
Subject: Restructure control file with cme.
---
debian/changelog | 7 +++++++
debian/control | 16 ++++++++--------
2 files changed, 15 insertions(+), 8 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index 748b6dc..3209d7d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
+
+ * Team upload.
+ * Restructure control file with cme.
+
+ -- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
+
libmonitoring-livestatus-perl (0.74-1) unstable; urgency=low
* New upstream release
diff --git a/debian/control b/debian/control
index 7efd2fe..2601688 100644
--- a/debian/control
+++ b/debian/control
@@ -1,21 +1,21 @@
Source: libmonitoring-livestatus-perl
+Maintainer: Debian Nagios Maintainer Group <pkg-nagios-devel at lists.alioth.debian.org>
+Uploaders: Alexander Wirt <formorer at debian.org>
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7.2.13)
Build-Depends-Indep: libjson-xs-perl,
- perl (>= 5.10.1)
-Maintainer: Debian Nagios Maintainer Group <pkg-nagios-devel at lists.alioth.debian.org>
-Uploaders: Alexander Wirt <formorer at debian.org>
+ perl
Standards-Version: 3.9.2
+Vcs-Browser: https://anonscm.debian.org/cgit/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
+Vcs-Git: git://anonscm.debian.org/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Homepage: http://search.cpan.org/dist/Monitoring-Livestatus/
-Vcs-Git: git://git.debian.org/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
-Vcs-Browser: http://git.debian.org/?p=pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Package: libmonitoring-livestatus-perl
Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends},
- libjson-xs-perl,
- perl (>= 5.10.1)
+Depends: ${misc:Depends},
+ ${perl:Depends},
+ libjson-xs-perl
Description: Perl API for check_mk livestatus to access runtime
Monitoring::Livestatus connects via socket/tcp to the check_mk livestatus
addon for Nagios and Icinga. You first have to install and activate the
--
2.1.4
-------------- next part --------------
>From 90a58c2ce25f9f4f0ef892fe7e03e385a87f4503 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:22:27 +0100
Subject: Bump debhelper compatibility to 9.
---
debian/changelog | 1 +
debian/compat | 2 +-
debian/control | 2 +-
3 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index 1a62bf1..523e453 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,6 +5,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Update Vcs-Git URL to use HTTPS.
* Use metacpan.org instead of search.cpan.org.
* Update copyright file using copyright-format 1.0.
+ * Bump debhelper compatibility to 9.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
diff --git a/debian/compat b/debian/compat
index 7f8f011..ec63514 100644
--- a/debian/compat
+++ b/debian/compat
@@ -1 +1 @@
-7
+9
diff --git a/debian/control b/debian/control
index 5330d25..a0ff313 100644
--- a/debian/control
+++ b/debian/control
@@ -3,7 +3,7 @@ Maintainer: Debian Nagios Maintainer Group <pkg-nagios-devel at lists.alioth.debian
Uploaders: Alexander Wirt <formorer at debian.org>
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7.2.13)
+Build-Depends: debhelper (>= 9)
Build-Depends-Indep: libjson-xs-perl,
perl
Standards-Version: 3.9.2
--
2.1.4
-------------- next part --------------
>From fc4fc22ca567a2a597e05f9a9b543a5588c56d23 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 13:01:35 +0100
Subject: Switch to source format 3.0 (quilt).
---
debian/changelog | 1 +
debian/source/format | 1 +
2 files changed, 2 insertions(+)
create mode 100644 debian/source/format
diff --git a/debian/changelog b/debian/changelog
index c8f1ca7..71b9ac3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,7 @@ libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Update copyright file using copyright-format 1.0.
* Bump debhelper compatibility to 9.
* Enable parallel builds.
+ * Switch to source format 3.0 (quilt).
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
diff --git a/debian/source/format b/debian/source/format
new file mode 100644
index 0000000..163aaf8
--- /dev/null
+++ b/debian/source/format
@@ -0,0 +1 @@
+3.0 (quilt)
--
2.1.4
-------------- next part --------------
>From 2f9bd35ac6330add45bb55a51f60b2cef8974efb Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 14:42:01 +0100
Subject: Bump Standards-Version to 3.9.8, changes: copyright-format 1.0.
---
debian/changelog | 1 +
debian/control | 2 +-
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/debian/changelog b/debian/changelog
index aba82d4..9e751ee 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -12,6 +12,7 @@ libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Add patch to fix testfile existence test.
* Add build dependencies on procps & netcat for tests.
* Add patch to fix spelling errors.
+ * Bump Standards-Version to 3.9.8, changes: copyright-format 1.0.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
diff --git a/debian/control b/debian/control
index 17d935b..4307703 100644
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Build-Depends-Indep: libjson-xs-perl,
netcat,
perl,
procps
-Standards-Version: 3.9.2
+Standards-Version: 3.9.8
Vcs-Browser: https://anonscm.debian.org/cgit/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Vcs-Git: https://anonscm.debian.org/git/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Homepage: https://metacpan.org/release/Monitoring-Livestatus
--
2.1.4
-------------- next part --------------
>From 2391ae1543e6f2686a5c6baf16e1f56820415a5c Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:27:58 +0100
Subject: Imported Upstream version 0.76
---
Changes | 4 +
MANIFEST | 2 +-
META.yml | 17 +-
Makefile.PL | 2 -
inc/Module/AutoInstall.pm | 180 +++++-
inc/Module/Install.pm | 26 +-
inc/Module/Install/AutoInstall.pm | 13 +-
inc/Module/Install/Base.pm | 2 +-
inc/Module/Install/Can.pm | 85 ++-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Include.pm | 2 +-
inc/Module/Install/Makefile.pm | 29 +-
inc/Module/Install/Metadata.pm | 33 +-
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 2 +-
lib/Monitoring/Livestatus.pm | 726 ++++++++++-----------
lib/Monitoring/Livestatus/INET.pm | 36 +-
lib/Monitoring/Livestatus/MULTI.pm | 922 ---------------------------
lib/Monitoring/Livestatus/UNIX.pm | 46 +-
t/01-Monitoring-Livestatus-basic_tests.t | 26 +-
t/02-Monitoring-Livestatus-internals.t | 12 +-
t/03-Monitoring-Livestatus-MULTI-internals.t | 215 -------
t/20-Monitoring-Livestatus-test_socket.t | 3 +
t/23-Monitoring-Livestatus-BigData.t | 85 +++
t/30-Monitoring-Livestatus-live-test.t | 78 +--
t/31-Monitoring-Livestatus-MULTI-live-test.t | 95 ---
t/32-Monitoring-Livestatus-backend-test.t | 10 +-
t/34-Monitoring-Livestatus-utf8_support.t | 8 +-
28 files changed, 834 insertions(+), 1829 deletions(-)
delete mode 100644 lib/Monitoring/Livestatus/MULTI.pm
delete mode 100644 t/03-Monitoring-Livestatus-MULTI-internals.t
create mode 100644 t/23-Monitoring-Livestatus-BigData.t
delete mode 100644 t/31-Monitoring-Livestatus-MULTI-live-test.t
diff --git a/Changes b/Changes
index d6cfd73..6432902 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
Revision history for Perl extension Monitoring::Livestatus.
+0.76 Tue Sep 27 21:45:25 CEST 2016
+ - fix utf-8 decoding error: missing high surrogate character in surrogate pair
+ - fixed typo
+ - removed MULTI class
0.74 Fri Apr 22 00:16:37 CEST 2011
- fixed problem with bulk commands
diff --git a/MANIFEST b/MANIFEST
index c0a5740..9295acc 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,7 +14,6 @@ inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Monitoring/Livestatus.pm
lib/Monitoring/Livestatus/INET.pm
-lib/Monitoring/Livestatus/MULTI.pm
lib/Monitoring/Livestatus/UNIX.pm
Makefile.PL
MANIFEST This list of files
@@ -26,6 +25,7 @@ t/03-Monitoring-Livestatus-MULTI-internals.t
t/20-Monitoring-Livestatus-test_socket.t
t/21-Monitoring-Livestatus-INET.t
t/22-Monitoring-Livestatus-UNIX.t
+t/23-Monitoring-Livestatus-BigData.t
t/30-Monitoring-Livestatus-live-test.t
t/31-Monitoring-Livestatus-MULTI-live-test.t
t/32-Monitoring-Livestatus-backend-test.t
diff --git a/META.yml b/META.yml
index 9def198..2c07561 100644
--- a/META.yml
+++ b/META.yml
@@ -1,13 +1,14 @@
---
-abstract: 'Perl API for check_mk livestatus to access runtime'
+abstract: 'Perl API for check_mk livestatus to access runtime data from Nagios and Icinga'
author:
- - 'Sven Nierlein, <nierlein at cpan.org>'
+ - 'Sven Nierlein, 2009-present, <sven at nierlein.org>'
build_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
configure_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
distribution_type: module
-generated_by: 'Module::Install version 1.00'
+dynamic_config: 1
+generated_by: 'Module::Install version 1.16'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -24,9 +25,7 @@ requires:
IO::Socket::INET: 0
IO::Socket::UNIX: 0
JSON::XS: 0
- Scalar::Util: 0
- Test::More: 0.87
- Thread::Queue: 2.11
+ Test::More: '0.87'
perl: 5.6.0
utf8: 0
resources:
@@ -34,4 +33,4 @@ resources:
homepage: http://search.cpan.org/dist/Monitoring-Livestatus/
license: http://dev.perl.org/licenses/
repository: http://github.com/sni/Monitoring-Livestatus
-version: 0.74
+version: '0.76'
diff --git a/Makefile.PL b/Makefile.PL
index ac02e63..3e0b6df 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -17,9 +17,7 @@ resources(
requires 'IO::Socket::UNIX';
requires 'IO::Socket::INET';
requires 'Digest::MD5';
-requires 'Scalar::Util';
requires 'Test::More' => '0.87';
-requires 'Thread::Queue' => '2.11';
requires 'utf8';
requires 'Encode';
requires 'JSON::XS';
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index 60b90ea..22dfa82 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -3,11 +3,12 @@ package Module::AutoInstall;
use strict;
use Cwd ();
+use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.03';
+ $VERSION = '1.16';
}
# special map on pre-defined feature sets
@@ -17,11 +18,14 @@ my %FeatureMap = (
);
# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
+ $UpgradeDeps
);
-my ( $PostambleActions, $PostambleUsed );
+my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
+ $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
+ $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
@@ -31,6 +35,10 @@ sub _accept_default {
$AcceptDefault = shift;
}
+sub _installdeps_target {
+ $InstallDepsTarget = shift;
+}
+
sub missing_modules {
return @Missing;
}
@@ -63,6 +71,11 @@ sub _init {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
+ elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
+ $UpgradeDeps = 1;
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
@@ -102,7 +115,7 @@ sub import {
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
$Config = [];
@@ -125,7 +138,7 @@ sub import {
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
- $UnderCPAN = _check_lock(1) unless $SkipInstall;
+ $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
@@ -153,7 +166,7 @@ sub import {
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
@@ -175,7 +188,7 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
- my $cur = _load($mod);
+ my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
@@ -207,6 +220,7 @@ sub import {
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
+ or $InstallDepsTarget
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
@@ -237,10 +251,17 @@ sub import {
}
}
- if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
- print
-"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+ my $make = $Config::Config{make};
+ if ($InstallDepsTarget) {
+ print
+"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
+ }
+ else {
+ print
+"*** Dependencies will be installed the next time you type '$make'.\n";
+ }
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
@@ -271,6 +292,10 @@ END_MESSAGE
sub _check_lock {
return unless @Missing or @_;
+ if ($ENV{PERL5_CPANM_IS_RUNNING}) {
+ return _running_under('cpanminus');
+ }
+
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
@@ -320,17 +345,26 @@ sub install {
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
- my ( @modules, @installed );
- while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+ my ( @modules, @installed, @modules_to_upgrade );
+ while (my ($pkg, $ver) = splice(@_, 0, 2)) {
- # grep out those already installed
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- else {
- push @modules, $pkg, $ver;
- }
- }
+ # grep out those already installed
+ if (_version_cmp(_version_of($pkg), $ver) >= 0) {
+ push @installed, $pkg;
+ if ($UpgradeDeps) {
+ push @modules_to_upgrade, $pkg, $ver;
+ }
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ if ($UpgradeDeps) {
+ push @modules, @modules_to_upgrade;
+ @installed = ();
+ @modules_to_upgrade = ();
+ }
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
@@ -363,7 +397,7 @@ sub install {
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -463,6 +497,11 @@ sub _cpanplus_config {
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
+ push @config, 'prereqs', $value;
+ } elsif ( $key eq 'force' ) {
+ push @config, $key, $value;
+ } elsif ( $key eq 'notest' ) {
+ push @config, 'skiptest', $value;
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
@@ -497,8 +536,12 @@ sub _install_cpan {
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
- if $opt =~ /^force$/; # pseudo-option
- $CPAN::Config->{$opt} = $arg;
+ if $opt =~ /^(?:force|notest)$/; # pseudo-option
+ $CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg;
+ }
+
+ if ($args{notest} && (not CPAN::Shell->can('notest'))) {
+ die "Your version of CPAN is too old to support the 'notest' pragma";
}
local $CPAN::Config->{prerequisites_policy} = 'follow';
@@ -519,8 +562,16 @@ sub _install_cpan {
delete $INC{$inc};
}
- my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
- : CPAN::Shell->install($pkg);
+ my $rv = do {
+ if ($args{force}) {
+ CPAN::Shell->force( install => $pkg )
+ } elsif ($args{notest}) {
+ CPAN::Shell->notest( install => $pkg )
+ } else {
+ CPAN::Shell->install($pkg)
+ }
+ };
+
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
@@ -564,7 +615,7 @@ sub _under_cpan {
require Cwd;
require File::Spec;
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cwd = File::Spec->canonpath( Cwd::getcwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
@@ -575,7 +626,7 @@ sub _update_to {
my $ver = shift;
return
- if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+ if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -660,16 +711,30 @@ sub _can_write {
# load a module and return the version it reports
sub _load {
- my $mod = pop; # class/instance doesn't matter
+ my $mod = pop; # method/function doesn't matter
my $file = $mod;
-
$file =~ s|::|/|g;
$file .= '.pm';
-
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
+# report version without loading a module
+sub _version_of {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ foreach my $dir ( @INC ) {
+ next if ref $dir;
+ my $path = File::Spec->catfile($dir, $file);
+ next unless -e $path;
+ require ExtUtils::MM_Unix;
+ return ExtUtils::MM_Unix->parse_version($path);
+ }
+ return undef;
+}
+
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
@@ -763,6 +828,35 @@ sub _make_args {
: "\$(NOECHO) \$(NOOP)"
);
+ my $deps_list = join( ',', @Missing, @Existing );
+
+ $PostambleActionsUpgradeDeps =
+ "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
+
+ my $config_notest =
+ join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
+ 'notest', 1 )
+ if $Config;
+
+ $PostambleActionsNoTest = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ $PostambleActionsUpgradeDepsNoTest =
+ "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
+
+ $PostambleActionsListDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
+
+ my @all = (@Missing, @Existing);
+
+ $PostambleActionsListAllDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
+
return %args;
}
@@ -797,11 +891,15 @@ sub Write {
sub postamble {
$PostambleUsed = 1;
+ my $fragment;
- return <<"END_MAKE";
+ $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
+AUTO_INSTALL
+
+ $fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
@@ -809,12 +907,28 @@ checkdeps ::
installdeps ::
\t$PostambleActions
+installdeps_notest ::
+\t$PostambleActionsNoTest
+
+upgradedeps ::
+\t$PostambleActionsUpgradeDeps
+
+upgradedeps_notest ::
+\t$PostambleActionsUpgradeDepsNoTest
+
+listdeps ::
+\t$PostambleActionsListDeps
+
+listalldeps ::
+\t$PostambleActionsListAllDeps
+
END_MAKE
+ return $fragment;
}
1;
__END__
-#line 1071
+#line 1197
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 8ee839d..f44ab4d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,7 +17,7 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.005;
+use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.00';
+ $VERSION = '1.16';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -156,10 +156,10 @@ END_DIE
sub autoload {
my $self = shift;
my $who = $self->_caller;
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
+ my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
@@ -239,7 +239,7 @@ sub new {
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
@@ -338,7 +338,7 @@ sub find_extensions {
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
- foreach ( split //, $content ) {
+ foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -378,6 +378,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -386,6 +387,7 @@ END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -416,6 +418,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -425,6 +428,7 @@ END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -434,7 +438,7 @@ END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
-sub _version ($) {
+sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
@@ -450,12 +454,12 @@ sub _version ($) {
return $l + 0;
}
-sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
+sub _cmp {
+ _version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
+sub _CLASS {
(
defined $_[0]
and
@@ -467,4 +471,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2010 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index f1f5356..e19d259 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -73,6 +73,17 @@ sub auto_install {
);
}
+sub installdeps_target {
+ my ($self, @args) = @_;
+
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall::_installdeps_target(1);
+
+ $self->auto_install(@args);
+}
+
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index b55bda3..5762a74 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 71ccc27..d859276 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -3,13 +3,12 @@ package Module::Install::Can;
use strict;
use Config ();
-use File::Spec ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -29,7 +28,7 @@ sub can_use {
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
-# check if we can run some command
+# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
@@ -38,14 +37,88 @@ sub can_run {
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
-# can we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 156
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index ec1f106..41d3517 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index a28cd4c..2eb1d1f 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 5dfd0e9..e9918d2 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -133,7 +133,7 @@ sub makemaker_args {
return $args;
}
-# For mm args that take multiple space-seperated args,
+# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
@@ -215,18 +215,22 @@ sub write {
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
- $self->build_requires( 'ExtUtils::MakeMaker' => $v );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
@@ -241,7 +245,6 @@ in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
- $DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
@@ -412,4 +415,4 @@ sub postamble {
__END__
-#line 541
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index cfe45b3..9792685 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -151,15 +151,21 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
}
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
@@ -170,7 +176,7 @@ sub perl_version {
# Normalize the version
$version = $self->_perl_version($version);
- # We don't support the reall old versions
+ # We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
@@ -341,7 +347,7 @@ sub name_from {
^ \s*
package \s*
([\w:]+)
- \s* ;
+ [\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
@@ -515,6 +521,7 @@ sub __extract_license {
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
@@ -550,9 +557,9 @@ sub license_from {
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
- \Qhttp://rt.cpan.org/\E[^>]+|
- \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
- \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
@@ -581,7 +588,7 @@ sub bugtracker_from {
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
@@ -698,7 +705,7 @@ sub _write_mymeta_data {
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
- # Overwrite the non-configure dependency hashs
+ # Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index edc18b4..218a66b 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index d0f6599..530749b 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.16';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
diff --git a/lib/Monitoring/Livestatus.pm b/lib/Monitoring/Livestatus.pm
index ce092ae..d6785b4 100644
--- a/lib/Monitoring/Livestatus.pm
+++ b/lib/Monitoring/Livestatus.pm
@@ -3,17 +3,36 @@ package Monitoring::Livestatus;
use 5.006;
use strict;
use warnings;
-use Data::Dumper;
-use Carp;
+use Data::Dumper qw/Dumper/;
+use Carp qw/carp croak confess/;
use Digest::MD5 qw(md5_hex);
-use Monitoring::Livestatus::INET;
-use Monitoring::Livestatus::UNIX;
-use Monitoring::Livestatus::MULTI;
-use Encode;
-use JSON::XS;
+use JSON::XS ();
+use Storable qw/dclone/;
-our $VERSION = '0.74';
+use Monitoring::Livestatus::INET qw//;
+use Monitoring::Livestatus::UNIX qw//;
+our $VERSION = '0.76';
+
+
+# list of allowed options
+my $allowed_options = {
+ 'addpeer' => 1,
+ 'backend' => 1,
+ 'columns' => 1,
+ 'deepcopy' => 1,
+ 'header' => 1,
+ 'limit' => 1,
+ 'limit_start' => 1,
+ 'limit_length' => 1,
+ 'rename' => 1,
+ 'slice' => 1,
+ 'sum' => 1,
+ 'callbacks' => 1,
+ 'wrapped_json' => 1,
+ 'sort' => 1,
+ 'offset' => 1,
+};
=head1 NAME
@@ -30,17 +49,16 @@ data from Nagios and Icinga
=head1 DESCRIPTION
-This module connects via socket/tcp to the check_mk livestatus addon for Nagios
-and Icinga. You first have to install and activate the mklivestatus addon in your
-monitoring installation.
+This module connects via socket/tcp to the livestatus addon for Naemon, Nagios,
+Icinga and Shinken. You first have to install and activate the livestatus addon
+in your monitoring installation.
=head1 CONSTRUCTOR
=head2 new ( [ARGS] )
Creates an C<Monitoring::Livestatus> object. C<new> takes at least the
-socketpath. Arguments are in key-value pairs.
-See L<EXAMPLES> for more complex variants.
+socketpath. Arguments are in key-value pairs.
=over 4
@@ -50,7 +68,7 @@ path to the UNIX socket of check_mk livestatus
=item server
-use this server for a TCP connection
+uses this server for a TCP connection
=item peer
@@ -107,14 +125,6 @@ set a query timeout. Used for retrieving querys, Default 60sec
set a connect timeout. Used for initial connections, default 5sec
-=item use_threads
-
-only used with multiple backend connections.
-Default is to don't threads where available. As threads in perl
-are causing problems with tied resultset and using more memory.
-Querys are usually faster without threads, except for very slow backends
-connections.
-
=back
If the constructor is only passed a single argument, it is assumed to
@@ -123,34 +133,31 @@ be a the C<peer> specification. Use either socker OR server.
=cut
sub new {
- my $class = shift;
- unshift(@_, "peer") if scalar @_ == 1;
- my(%options) = @_;
+ my($class, at args) = @_;
+ unshift(@args, 'peer') if scalar @args == 1;
+ my(%options) = @args;
my $self = {
- "verbose" => 0, # enable verbose output
- "socket" => undef, # use unix sockets
- "server" => undef, # use tcp connections
- "peer" => undef, # use for socket / server connections
- "name" => undef, # human readable name
- "line_seperator" => 10, # defaults to newline
- "column_seperator" => 0, # defaults to null byte
- "list_seperator" => 44, # defaults to comma
- "host_service_seperator" => 124, # defaults to pipe
- "keepalive" => 0, # enable keepalive?
- "errors_are_fatal" => 1, # die on errors
- "backend" => undef, # should be keept undef, used internally
- "timeout" => undef, # timeout for tcp connections
- "query_timeout" => 60, # query timeout for tcp connections
- "connect_timeout" => 5, # connect timeout for tcp connections
- "timeout" => undef, # timeout for tcp connections
- "use_threads" => undef, # use threads, default is to use threads where available
- "warnings" => 1, # show warnings, for example on querys without Column: Header
- "logger" => undef, # logger object used for statistical informations and errors / warnings
- "deepcopy" => undef, # copy result set to avoid errors with tied structures
- "disabled" => 0, # if disabled, this peer will not receive any query
- "retries_on_connection_error" => 3, # retry x times to connect
- "retry_interval" => 1, # retry after x seconds
+ 'verbose' => 0, # enable verbose output
+ 'socket' => undef, # use unix sockets
+ 'server' => undef, # use tcp connections
+ 'peer' => undef, # use for socket / server connections
+ 'name' => undef, # human readable name
+ 'line_seperator' => 10, # defaults to newline
+ 'column_seperator' => 0, # defaults to null byte
+ 'list_seperator' => 44, # defaults to comma
+ 'host_service_seperator' => 124, # defaults to pipe
+ 'keepalive' => 0, # enable keepalive?
+ 'errors_are_fatal' => 1, # die on errors
+ 'backend' => undef, # should be keept undef, used internally
+ 'timeout' => undef, # timeout for tcp connections
+ 'query_timeout' => 60, # query timeout for tcp connections
+ 'connect_timeout' => 5, # connect timeout for tcp connections
+ 'warnings' => 1, # show warnings, for example on querys without Column: Header
+ 'logger' => undef, # logger object used for statistical informations and errors / warnings
+ 'deepcopy' => undef, # copy result set to avoid errors with tied structures
+ 'retries_on_connection_error' => 3, # retry x times to connect
+ 'retry_interval' => 1, # retry after x seconds
};
for my $opt_key (keys %options) {
@@ -162,9 +169,8 @@ sub new {
}
}
- if($self->{'verbose'} and !defined $self->{'logger'}) {
+ if($self->{'verbose'} && !defined $self->{'logger'}) {
croak('please specify a logger object when using verbose mode');
- $self->{'verbose'} = 0;
}
# setting a general timeout?
@@ -176,43 +182,28 @@ sub new {
bless $self, $class;
# set our peer(s) from the options
- my $peers = $self->_get_peers();
-
- if(!defined $peers) {
- croak('please specify at least one peer, socket or server');
- }
+ my $peer = $self->_get_peer();
if(!defined $self->{'backend'}) {
- if(scalar @{$peers} == 1) {
- my $peer = $peers->[0];
- $options{'name'} = $peer->{'name'};
- $options{'peer'} = $peer->{'peer'};
- if($peer->{'type'} eq 'UNIX') {
- $self->{'CONNECTOR'} = new Monitoring::Livestatus::UNIX(%options);
- }
- elsif($peer->{'type'} eq 'INET') {
- $self->{'CONNECTOR'} = new Monitoring::Livestatus::INET(%options);
- }
- $self->{'peer'} = $peer->{'peer'};
+ $options{'name'} = $peer->{'name'};
+ $options{'peer'} = $peer->{'peer'};
+ if($peer->{'type'} eq 'UNIX') {
+ $self->{'CONNECTOR'} = Monitoring::Livestatus::UNIX->new(%options);
}
- else {
- $options{'peer'} = $peers;
- return new Monitoring::Livestatus::MULTI(%options);
+ elsif($peer->{'type'} eq 'INET') {
+ $self->{'CONNECTOR'} = Monitoring::Livestatus::INET->new(%options);
}
+ $self->{'peer'} = $peer->{'peer'};
}
# set names and peer for non multi backends
- if(defined $self->{'CONNECTOR'}->{'name'} and !defined $self->{'name'}) {
+ if(defined $self->{'CONNECTOR'}->{'name'} && !defined $self->{'name'}) {
$self->{'name'} = $self->{'CONNECTOR'}->{'name'};
}
- if(defined $self->{'CONNECTOR'}->{'peer'} and !defined $self->{'peer'}) {
+ if(defined $self->{'CONNECTOR'}->{'peer'} && !defined $self->{'peer'}) {
$self->{'peer'} = $self->{'CONNECTOR'}->{'peer'};
}
- if($self->{'verbose'} and (!defined $self->{'backend'} or $self->{'backend'} ne 'Monitoring::Livestatus::MULTI')) {
- $self->{'logger'}->debug('initialized Monitoring::Livestatus ('.$self->peer_name.')');
- }
-
return $self;
}
@@ -232,10 +223,8 @@ Always returns true.
=cut
sub do {
- my $self = shift;
- my $statement = shift;
- return if $self->{'disabled'};
- $self->_send($statement);
+ my($self, $statement, $opt) = @_;
+ $self->_send($statement, $opt);
return(1);
}
@@ -264,7 +253,7 @@ to get an array of hash references from the first 2 returned rows only
"GET hosts", { Slice => {} }, 2
);
-use limit to limit the result to this number of rows
+you may use limit to limit the result to this number of rows
column aliases can be defined with a rename hash
@@ -280,55 +269,64 @@ column aliases can be defined with a rename hash
=cut
sub selectall_arrayref {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
- my $limit = shift || 0;
- return if $self->{'disabled'};
- my $result;
+ my($self, $statement, $opt, $limit, $result) = @_;
+ $limit = 0 unless defined $limit;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
-
- $self->_log_statement($statement, $opt, $limit) if $self->{'verbose'};
+ $opt = &_lowercase_and_verify_options($self, $opt) unless $result;
- $result = $self->_send($statement, $opt);
+ $self->_log_statement($statement, $opt, $limit) if !$result && $self->{'verbose'};
if(!defined $result) {
- return unless $self->{'errors_are_fatal'};
- croak("got undef result for: $statement");
+ $result = &_send($self, $statement, $opt);
+ return $result if $ENV{'THRUK_SELECT'};
+
+ if(!defined $result) {
+ return unless $self->{'errors_are_fatal'};
+ croak("got undef result for: $statement");
+ }
}
# trim result set down to excepted row count
- if(defined $limit and $limit >= 1) {
+ if(!$opt->{'offset'} && defined $limit && $limit >= 1) {
if(scalar @{$result->{'result'}} > $limit) {
@{$result->{'result'}} = @{$result->{'result'}}[0..$limit-1];
}
}
if($opt->{'slice'}) {
- # make an array of hashes
- my @hash_refs;
- for my $res (@{$result->{'result'}}) {
- my $hash_ref;
- for(my $x=0;$x<scalar @{$res};$x++) {
- my $key = $result->{'keys'}->[$x];
- if(exists $opt->{'rename'} and defined $opt->{'rename'}->{$key}) {
- $key = $opt->{'rename'}->{$key};
+ my $callbacks = $opt->{'callbacks'};
+ # make an array of hashes, inplace to safe memory
+ my $keys = $result->{'keys'};
+ # renamed columns
+ if($opt->{'rename'}) {
+ $keys = dclone($result->{'keys'});
+ my $keysize = scalar @{$keys};
+ for(my $x=0; $x<$keysize;$x++) {
+ my $old = $keys->[$x];
+ if($opt->{'rename'}->{$old}) {
+ $keys->[$x] = $opt->{'rename'}->{$old};
}
- $hash_ref->{$key} = $res->[$x];
}
+ }
+ $result = $result->{'result'};
+ my $rnum = scalar @{$result};
+ for(my $x=0;$x<$rnum;$x++) {
+ # sort array into hash slices
+ my %hash;
+ @hash{@{$keys}} = @{$result->[$x]};
# add callbacks
- if(exists $opt->{'callbacks'}) {
- for my $key (keys %{$opt->{'callbacks'}}) {
- $hash_ref->{$key} = $opt->{'callbacks'}->{$key}->($hash_ref);
+ if($callbacks) {
+ for my $key (keys %{$callbacks}) {
+ $hash{$key} = $callbacks->{$key}->(\%hash);
}
}
- push @hash_refs, $hash_ref;
+ $result->[$x] = \%hash;
}
- return(\@hash_refs);
+ return($result);
}
- elsif(exists $opt->{'callbacks'}) {
+
+ if(exists $opt->{'callbacks'}) {
for my $res (@{$result->{'result'}}) {
# add callbacks
if(exists $opt->{'callbacks'}) {
@@ -337,14 +335,11 @@ sub selectall_arrayref {
}
}
}
- }
- if(exists $opt->{'callbacks'}) {
for my $key (keys %{$opt->{'callbacks'}}) {
push @{$result->{'keys'}}, $key;
}
}
-
return($result->{'result'});
}
@@ -363,16 +358,13 @@ Sends a query and returns a hashref with the given key
=cut
sub selectall_hashref {
- my $self = shift;
- my $statement = shift;
- my $key_field = shift;
- my $opt = shift;
+ my($self, $statement, $key_field, $opt) = @_;
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
$opt->{'slice'} = 1;
- croak("key is required for selectall_hashref") if !defined $key_field;
+ croak('key is required for selectall_hashref') if !defined $key_field;
my $result = $self->selectall_arrayref($statement, $opt);
@@ -436,15 +428,13 @@ produces a hash with host the contact assosiation
=cut
sub selectcol_arrayref {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
# if now colums are set, use just the first one
- if(!defined $opt->{'columns'} or ref $opt->{'columns'} ne 'ARRAY') {
+ if(!defined $opt->{'columns'} || ref $opt->{'columns'} ne 'ARRAY') {
@{$opt->{'columns'}} = qw{1};
}
@@ -475,12 +465,10 @@ returns undef if nothing was found
=cut
sub selectrow_array {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
my @result = @{$self->selectall_arrayref($statement, $opt, 1)};
return @{$result[0]} if scalar @result > 0;
@@ -503,12 +491,10 @@ returns undef if nothing was found
=cut
sub selectrow_arrayref {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
my $result = $self->selectall_arrayref($statement, $opt, 1);
return if !defined $result;
@@ -532,12 +518,10 @@ returns undef if nothing was found
=cut
sub selectrow_hashref {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
$opt->{slice} = 1;
my $result = $self->selectall_arrayref($statement, $opt, 1);
@@ -562,12 +546,10 @@ returns undef if nothing was found
=cut
sub selectscalar_value {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
# make opt hash keys lowercase
- $opt = $self->_lowercase_and_verify_options($opt);
+ $opt = &_lowercase_and_verify_options($self, $opt);
my $row = $self->selectrow_arrayref($statement);
return if !defined $row;
@@ -588,8 +570,7 @@ returns the current setting if called without new value
=cut
sub errors_are_fatal {
- my $self = shift;
- my $value = shift;
+ my($self, $value) = @_;
my $old = $self->{'errors_are_fatal'};
$self->{'errors_are_fatal'} = $value;
@@ -611,8 +592,7 @@ returns the current setting if called without new value
=cut
sub warnings {
- my $self = shift;
- my $value = shift;
+ my($self, $value) = @_;
my $old = $self->{'warnings'};
$self->{'warnings'} = $value;
@@ -636,8 +616,7 @@ returns the current setting if called without new value
=cut
sub verbose {
- my $self = shift;
- my $value = shift;
+ my($self, $value) = @_;
my $old = $self->{'verbose'};
$self->{'verbose'} = $value;
@@ -659,9 +638,8 @@ when using multiple backends, a list of all addresses is returned in list contex
=cut
sub peer_addr {
- my $self = shift;
-
- return "".$self->{'peer'};
+ my($self) = @_;
+ return ''.$self->{'peer'};
}
@@ -680,14 +658,13 @@ when using multiple backends, a list of all names is returned in list context
=cut
sub peer_name {
- my $self = shift;
- my $value = shift;
+ my($self, $value) = @_;
if(defined $value and $value ne '') {
$self->{'name'} = $value;
}
- return "".$self->{'name'};
+ return ''.$self->{'name'};
}
@@ -703,81 +680,26 @@ when using multiple backends, a list of all keys is returned in list context
=cut
sub peer_key {
- my $self = shift;
+ my($self) = @_;
- if(!defined $self->{'key'}) { $self->{'key'} = md5_hex($self->peer_addr." ".$self->peer_name); }
+ if(!defined $self->{'key'}) { $self->{'key'} = md5_hex($self->peer_addr.' '.$self->peer_name); }
return $self->{'key'};
}
-
-########################################
-
-=head2 marked_bad
-
- $ml->marked_bad()
-
-returns true if the current connection is marked down
-
-=cut
-sub marked_bad {
- my $self = shift;
-
- return 0;
-}
-
-
-########################################
-
-=head2 disable
-
- $ml->disable()
-
-disables this connection, returns the last state.
-
-=cut
-sub disable {
- my $self = shift;
- my $prev = $self->{'disabled'};
- $self->{'disabled'} = 1;
- return $prev;
-}
-
-
-########################################
-
-=head2 enable
-
- $ml->enable()
-
-enables this connection, returns the last state.
-
-=cut
-sub enable {
- my $self = shift;
- my $prev = $self->{'disabled'};
- $self->{'disabled'} = 0;
- return $prev;
-}
-
########################################
# INTERNAL SUBS
########################################
sub _send {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
+ my($self, $statement, $opt) = @_;
+
+ confess('duplicate data') if $opt->{'data'};
delete $self->{'meta_data'};
- my $header = "";
+ my $header = '';
my $keys;
- my $with_peers = 0;
- if(defined $opt->{'addpeer'} and $opt->{'addpeer'}) {
- $with_peers = 1;
- }
-
$Monitoring::Livestatus::ErrorCode = 0;
undef $Monitoring::Livestatus::ErrorMessage;
@@ -840,12 +762,28 @@ sub _send {
if($statement =~ m/^Columns:\ (.*)$/mx) {
($statement,$keys) = $self->_extract_keys_from_columns_header($statement);
} elsif($statement =~ m/^Stats:\ (.*)$/mx or $statement =~ m/^StatsGroupBy:\ (.*)$/mx) {
- ($statement,$keys) = $self->_extract_keys_from_stats_statement($statement);
+ ($statement,$keys) = extract_keys_from_stats_statement($statement);
+ }
+
+ # Offset header (currently naemon only)
+ if(defined $opt->{'offset'}) {
+ $statement .= "\nOffset: ".$opt->{'offset'};
+ }
+
+ # Sort header (currently naemon only)
+ if(defined $opt->{'sort'}) {
+ for my $sort (@{$opt->{'sort'}}) {
+ $statement .= "\nSort: ".$sort;
+ }
}
# Commands need no additional header
if($statement !~ m/^COMMAND/mx) {
- $header .= "OutputFormat: json\n";
+ if($opt->{'wrapped_json'}) {
+ $header .= "OutputFormat: wrapped_json\n";
+ } else {
+ $header .= "OutputFormat: json\n";
+ }
$header .= "ResponseHeader: fixed16\n";
if($self->{'keepalive'}) {
$header .= "KeepAlive: on\n";
@@ -857,25 +795,27 @@ sub _send {
# add additional headers
if(defined $opt->{'header'} and ref $opt->{'header'} eq 'HASH') {
for my $key ( keys %{$opt->{'header'}}) {
- $header .= $key.": ".$opt->{'header'}->{$key}."\n";
+ $header .= $key.': '.$opt->{'header'}->{$key}."\n";
}
}
chomp($statement);
my $send = "$statement\n$header";
- $self->{'logger'}->debug("> ".Dumper($send)) if $self->{'verbose'};
- ($status,$msg,$body) = $self->_send_socket($send);
+ $self->{'logger'}->debug('> '.Dumper($send)) if $self->{'verbose'};
+ ($status,$msg,$body) = &_send_socket($self, $send);
+ return([$status, $opt, $keys]) if $ENV{'THRUK_SELECT'};
if($self->{'verbose'}) {
#$self->{'logger'}->debug("got:");
#$self->{'logger'}->debug(Dumper(\@erg));
- $self->{'logger'}->debug("status: ".Dumper($status));
- $self->{'logger'}->debug("msg: ".Dumper($msg));
- $self->{'logger'}->debug("< ".Dumper($body));
+ $self->{'logger'}->debug('status: '.Dumper($status));
+ $self->{'logger'}->debug('msg: '.Dumper($msg));
+ $self->{'logger'}->debug('< '.Dumper($body));
}
}
- if($status >= 300) {
- $body = '' if !defined $body;
+ if(!$status || $status >= 300) {
+ $body = '' if !defined $body;
+ $status = 300 if !defined $status;
chomp($body);
$Monitoring::Livestatus::ErrorCode = $status;
if(defined $body and $body ne '') {
@@ -883,9 +823,9 @@ sub _send {
} else {
$Monitoring::Livestatus::ErrorMessage = $msg;
}
- $self->{'logger'}->error($status." - ".$Monitoring::Livestatus::ErrorMessage." in query:\n'".$statement) if $self->{'verbose'};
+ $self->{'logger'}->error($status.' - '.$Monitoring::Livestatus::ErrorMessage." in query:\n".$statement) if $self->{'verbose'};
if($self->{'errors_are_fatal'}) {
- croak("ERROR ".$status." - ".$Monitoring::Livestatus::ErrorMessage." in query:\n'".$statement."'\n");
+ croak('ERROR '.$status.' - '.$Monitoring::Livestatus::ErrorMessage." in query:\n".$statement."\n");
}
return;
}
@@ -893,40 +833,89 @@ sub _send {
# return a empty result set if nothing found
return({ keys => [], result => []}) if !defined $body;
- my $line_seperator = chr($self->{'line_seperator'});
- my $col_seperator = chr($self->{'column_seperator'});
-
- my $peer_name = $self->peer_name;
- my $peer_addr = $self->peer_addr;
- my $peer_key = $self->peer_key;
-
my $limit_start = 0;
if(defined $opt->{'limit_start'}) { $limit_start = $opt->{'limit_start'}; }
+ # body is already parsed
my $result;
- # fix json output
- $body =~ s/\],\n\]\n$/]]/mx;
- eval {
- $result = decode_json($body);
- };
- if($@) {
- my $message = "ERROR ".$@." in text: '".$body."'\" for statement: '$statement'\n";
+ if($status == 200) {
+ $result = $body;
+ } else {
+ my $json_decoder = JSON::XS->new->utf8->relaxed;
+ # fix json output
+ eval {
+ $result = $json_decoder->decode($body);
+ };
+ # fix low/high surrogate errors
+ # missing high surrogate character in surrogate pair
+ # surrogate pair expected
+ if($@) {
+ # replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates)
+ $body =~ s/\\ud[89a-f]\w{2}/\\ufffd/gmxi;
+ eval {
+ $result = $json_decoder->decode($body);
+ };
+ }
+ if($@) {
+ my $message = 'ERROR '.$@." in text: '".$body."'\" for statement: '$statement'\n";
+ $self->{'logger'}->error($message) if $self->{'verbose'};
+ if($self->{'errors_are_fatal'}) {
+ croak($message);
+ }
+ return({ keys => [], result => []});
+ }
+ }
+ if(!defined $result) {
+ my $message = "ERROR undef result for text: '".$body."'\" for statement: '$statement'\n";
$self->{'logger'}->error($message) if $self->{'verbose'};
if($self->{'errors_are_fatal'}) {
croak($message);
}
+ return({ keys => [], result => []});
}
# for querys with column header, no separate columns will be returned
if(!defined $keys) {
- $self->{'logger'}->warn("got statement without Columns: header!") if $self->{'verbose'};
+ $self->{'logger'}->warn('got statement without Columns: header!') if $self->{'verbose'};
if($self->{'warnings'}) {
- carp("got statement without Columns: header! -> ".$statement);
+ carp('got statement without Columns: header! -> '.$statement);
}
$keys = shift @{$result};
}
+ return(&post_processing($self, $result, $opt, $keys));
+}
+
+########################################
+
+=head2 post_processing
+
+ $ml->post_processing($result, $options, $keys)
+
+returns postprocessed result.
+
+Useful when using select based io.
+
+=cut
+sub post_processing {
+ my($self, $result, $opt, $keys) = @_;
+
+ my $orig_result;
+ if($opt->{'wrapped_json'}) {
+ $orig_result = $result;
+ $result = $result->{'data'};
+ }
+
# add peer information?
+ my $with_peers = 0;
+ if(defined $opt->{'addpeer'} and $opt->{'addpeer'}) {
+ $with_peers = 1;
+ }
+
if(defined $with_peers and $with_peers == 1) {
+ my $peer_name = $self->peer_name;
+ my $peer_addr = $self->peer_addr;
+ my $peer_key = $self->peer_key;
+
unshift @{$keys}, 'peer_name';
unshift @{$keys}, 'peer_addr';
unshift @{$keys}, 'peer_key';
@@ -940,20 +929,25 @@ sub _send {
# set some metadata
$self->{'meta_data'} = {
- 'result_count' => scalar @${result},
+ 'result_count' => scalar @{$result},
};
+ if($opt->{'wrapped_json'}) {
+ for my $key (keys %{$orig_result}) {
+ next if $key eq 'data';
+ $self->{'meta_data'}->{$key} = $orig_result->{$key};
+ }
+ }
return({ keys => $keys, result => $result });
}
########################################
sub _open {
- my $self = shift;
- my $statement = shift;
+ my($self) = @_;
# return the current socket in keep alive mode
if($self->{'keepalive'} and defined $self->{'sock'} and $self->{'sock'}->connected) {
- $self->{'logger'}->debug("reusing old connection") if $self->{'verbose'};
+ $self->{'logger'}->debug('reusing old connection') if $self->{'verbose'};
return($self->{'sock'});
}
@@ -964,14 +958,13 @@ sub _open {
$self->{'sock'} = $sock;
}
- $self->{'logger'}->debug("using new connection") if $self->{'verbose'};
+ $self->{'logger'}->debug('using new connection') if $self->{'verbose'};
return($sock);
}
########################################
sub _close {
- my $self = shift;
- my $sock = shift;
+ my($self, $sock) = @_;
undef $self->{'sock'};
return($self->{'CONNECTOR'}->_close($sock));
}
@@ -1077,29 +1070,31 @@ The values from all backends with be summed up to a total.
########################################
# wrapper around _send_socket_do
sub _send_socket {
- my $self = shift;
- my $statement = shift;
+ my($self, $statement) = @_;
my $retries = 0;
- my($status, $msg, $recv);
-
+ my($status, $msg, $recv, $sock);
# try to avoid connection errors
eval {
local $SIG{PIPE} = sub {
- die("broken pipe");
- $self->{'logger'}->debug("broken pipe, closing socket") if $self->{'verbose'};
- $self->_close($self->{'sock'});
+ die('broken pipe');
};
if($self->{'retries_on_connection_error'} <= 0) {
- ($status, $msg, $recv) = $self->_send_socket_do($statement);
- return;
+ ($sock, $msg, $recv) = &_send_socket_do($self, $statement);
+ return($sock, $msg, $recv) if $msg;
+ return $sock if $ENV{'THRUK_SELECT'};
+ ($status, $msg, $recv) = &_read_socket_do($self, $sock, $statement);
+ return($status, $msg, $recv);
}
- while((!defined $status or ($status == 491 or $status == 497 or $status == 500)) and $retries < $self->{'retries_on_connection_error'}) {
+ while((!defined $status || ($status == 491 || $status == 497 || $status == 500)) && $retries < $self->{'retries_on_connection_error'}) {
$retries++;
- ($status, $msg, $recv) = $self->_send_socket_do($statement);
+ ($sock, $msg, $recv) = &_send_socket_do($self, $statement);
+ return($status, $msg, $recv) if $msg;
+ return $sock if $ENV{'THRUK_SELECT'};
+ ($status, $msg, $recv) = &_read_socket_do($self, $sock, $statement);
$self->{'logger'}->debug('query status '.$status) if $self->{'verbose'};
if($status == 491 or $status == 497 or $status == 500) {
$self->{'logger'}->debug('got status '.$status.' retrying in '.$self->{'retry_interval'}.' seconds') if $self->{'verbose'};
@@ -1111,11 +1106,16 @@ sub _send_socket {
if($@) {
$self->{'logger'}->debug("try 1 failed: $@") if $self->{'verbose'};
if(defined $@ and $@ =~ /broken\ pipe/mx) {
- return $self->_send_socket_do($statement);
+ ($sock, $msg, $recv) = &_send_socket_do($self, $statement);
+ return($status, $msg, $recv) if $msg;
+ return $sock if $ENV{'THRUK_SELECT'};
+ return(&_read_socket_do($self, $sock, $statement));
}
croak($@) if $self->{'errors_are_fatal'};
}
+ $status = $sock unless $status;
+ return $sock if $ENV{'THRUK_SELECT'};
croak($msg) if($status >= 400 and $self->{'errors_are_fatal'});
return($status, $msg, $recv);
@@ -1123,27 +1123,52 @@ sub _send_socket {
########################################
sub _send_socket_do {
- my $self = shift;
- my $statement = shift;
- my($recv,$header);
-
- my $sock = $self->_open() or return(491, $self->_get_error(491), $!);
+ my($self, $statement) = @_;
+ my $sock = $self->_open() or return(491, $self->_get_error(491, $!), $!);
utf8::decode($statement);
- print $sock encode('utf-8' => $statement) or return($self->_socket_error($statement, $sock, 'write to socket failed: '.$!));
-
+ utf8::encode($statement);
+ print $sock $statement or return($self->_socket_error($statement, $sock, 'write to socket failed: '.$!));
print $sock "\n";
+ return $sock;
+}
+
+########################################
+sub _read_socket_do {
+ my($self, $sock, $statement) = @_;
+ my($recv,$header);
# COMMAND statements never return something
- if($statement =~ m/^COMMAND/mx) {
+ if($statement && $statement =~ m/^COMMAND/mx) {
return('201', $self->_get_error(201), undef);
}
$sock->read($header, 16) or return($self->_socket_error($statement, $sock, 'reading header from socket failed, check your livestatus logfile: '.$!));
$self->{'logger'}->debug("header: $header") if $self->{'verbose'};
- my($status, $msg, $content_length) = $self->_parse_header($header, $sock);
+ my($status, $msg, $content_length) = &_parse_header($self, $header, $sock);
return($status, $msg, undef) if !defined $content_length;
+ our $json_decoder;
+ if($json_decoder) {
+ $json_decoder->incr_reset;
+ } else {
+ $json_decoder = JSON::XS->new->utf8->relaxed;
+ }
if($content_length > 0) {
- $sock->read($recv, $content_length) or return($self->_socket_error($statement, $sock, 'reading body from socket failed'));
+ if($status == 200) {
+ my $remaining = $content_length;
+ my $length = 32768;
+ if($remaining < $length) { $length = $remaining; }
+ while($length > 0 && $sock->read(my $buf, $length)) {
+ # replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates)
+ $buf =~ s/\\ud[89a-f]\w{2}/\\ufffd/gmxio;
+ $json_decoder->incr_parse($buf);
+ $remaining = $remaining -$length;
+ if($remaining < $length) { $length = $remaining; }
+ }
+ $recv = $json_decoder->incr_parse or return($self->_socket_error($statement, $sock, 'reading body from socket failed: '.$json_decoder->incr_text.$json_decoder->incr_reset));
+ $json_decoder->incr_reset;
+ } else {
+ $sock->read($recv, $content_length) or return($self->_socket_error($statement, $sock, 'reading body from socket failed'));
+ }
}
$self->_close($sock) unless $self->{'keepalive'};
@@ -1152,10 +1177,8 @@ sub _send_socket_do {
########################################
sub _socket_error {
- my $self = shift;
- my $statement = shift;
- my $sock = shift;
- my $body = shift;
+ #my($self, $statement, $sock, $body)...
+ my($self, $statement, undef, $body) = @_;
my $message = "\n";
$message .= "peer ".Dumper($self->peer_name);
@@ -1178,9 +1201,7 @@ sub _socket_error {
########################################
sub _parse_header {
- my $self = shift;
- my $header = shift;
- my $sock = shift;
+ my($self, $header, $sock) = @_;
if(!defined $header) {
return(497, $self->_get_error(497), undef);
@@ -1237,29 +1258,40 @@ pairs:
=cut
########################################
-sub _extract_keys_from_stats_statement {
- my $self = shift;
- my $statement = shift;
+
+=head2 extract_keys_from_stats_statement
+
+ extract_keys_from_stats_statement($statement)
+
+Extract column keys from statement.
+
+=cut
+sub extract_keys_from_stats_statement {
+ my($statement) = @_;
my(@header, $new_statement);
for my $line (split/\n/mx, $statement) {
- if($line =~ m/^Stats:\ (.*)\s+as\s+(.*)$/mxi) {
+ if(substr($line, 0, 5) ne 'Stats') { # faster shortcut for non-stats lines
+ $new_statement .= $line."\n";
+ next;
+ }
+ if($line =~ m/^Stats:\ (.*)\s+as\s+(.*?)$/mxo) {
push @header, $2;
$line = 'Stats: '.$1;
}
- elsif($line =~ m/^Stats:\ (.*)$/mx) {
+ elsif($line =~ m/^Stats:\ (.*)$/mxo) {
push @header, $1;
}
- if($line =~ m/^StatsAnd:\ (\d+)\s+as\s+(.*)$/mx) {
+ elsif($line =~ m/^StatsAnd:\ (\d+)\s+as\s+(.*?)$/mxo) {
for(my $x = 0; $x < $1; $x++) {
pop @header;
}
$line = 'StatsAnd: '.$1;
push @header, $2;
}
- elsif($line =~ m/^StatsAnd:\ (\d+)$/mx) {
+ elsif($line =~ m/^StatsAnd:\ (\d+)$/mxo) {
my @to_join;
for(my $x = 0; $x < $1; $x++) {
unshift @to_join, pop @header;
@@ -1267,14 +1299,14 @@ sub _extract_keys_from_stats_statement {
push @header, join(' && ', @to_join);
}
- if($line =~ m/^StatsOr:\ (\d+)\s+as\s+(.*)$/mx) {
+ elsif($line =~ m/^StatsOr:\ (\d+)\s+as\s+(.*?)$/mxo) {
for(my $x = 0; $x < $1; $x++) {
pop @header;
}
$line = 'StatsOr: '.$1;
push @header, $2;
}
- elsif($line =~ m/^StatsOr:\ (\d+)$/mx) {
+ elsif($line =~ m/^StatsOr:\ (\d+)$/mxo) {
my @to_join;
for(my $x = 0; $x < $1; $x++) {
unshift @to_join, pop @header;
@@ -1283,11 +1315,11 @@ sub _extract_keys_from_stats_statement {
}
# StatsGroupBy header are always sent first
- if($line =~ m/^StatsGroupBy:\ (.*)\s+as\s+(.*)$/mxi) {
+ elsif($line =~ m/^StatsGroupBy:\ (.*)\s+as\s+(.*?)$/mxo) {
unshift @header, $2;
$line = 'StatsGroupBy: '.$1;
}
- elsif($line =~ m/^StatsGroupBy:\ (.*)$/mx) {
+ elsif($line =~ m/^StatsGroupBy:\ (.*)$/mxo) {
unshift @header, $1;
}
$new_statement .= $line."\n";
@@ -1298,8 +1330,7 @@ sub _extract_keys_from_stats_statement {
########################################
sub _extract_keys_from_columns_header {
- my $self = shift;
- my $statement = shift;
+ my($self, $statement) = @_;
my(@header, $new_statement);
for my $line (split/\n/mx, $statement) {
@@ -1337,8 +1368,7 @@ Errorhandling can be done like this:
=cut
sub _get_error {
- my $self = shift;
- my $code = shift;
+ my($self, $code, $append) = @_;
my $codes = {
'200' => 'OK. Reponse contains the queried data.',
@@ -1349,6 +1379,7 @@ sub _get_error {
'403' => 'The request is incomplete.',
'404' => 'The target of the GET has not been found (e.g. the table).',
'405' => 'A non-existing column was being referred to',
+ '452' => 'internal livestatus error',
'490' => 'no query',
'491' => 'failed to connect',
'492' => 'Separators not allowed in statement. Please use the seperator options in new()',
@@ -1363,50 +1394,44 @@ sub _get_error {
};
confess('non existant error code: '.$code) if !defined $codes->{$code};
+ my $msg = $codes->{$code};
+ $msg .= ' - '.$append if $append;
- return($codes->{$code});
+ return($msg);
}
########################################
-sub _get_peers {
- my $self = shift;
-
- # set options for our peer(s)
- my %options;
- for my $opt_key (keys %{$self}) {
- $options{$opt_key} = $self->{$opt_key};
- }
-
- my $peers = [];
+sub _get_peer {
+ my($self) = @_;
# check if the supplied peer is a socket or a server address
if(defined $self->{'peer'}) {
if(ref $self->{'peer'} eq '') {
- my $name = $self->{'name'} || "".$self->{'peer'};
+ my $name = $self->{'name'} || ''.$self->{'peer'};
if(index($self->{'peer'}, ':') > 0) {
- push @{$peers}, { 'peer' => "".$self->{'peer'}, type => 'INET', name => $name };
+ return({ 'peer' => ''.$self->{'peer'}, type => 'INET', name => $name });
} else {
- push @{$peers}, { 'peer' => "".$self->{'peer'}, type => 'UNIX', name => $name };
+ return({ 'peer' => ''.$self->{'peer'}, type => 'UNIX', name => $name });
}
}
elsif(ref $self->{'peer'} eq 'ARRAY') {
for my $peer (@{$self->{'peer'}}) {
if(ref $peer eq 'HASH') {
next if !defined $peer->{'peer'};
- $peer->{'name'} = "".$peer->{'peer'} unless defined $peer->{'name'};
+ $peer->{'name'} = ''.$peer->{'peer'} unless defined $peer->{'name'};
if(!defined $peer->{'type'}) {
$peer->{'type'} = 'UNIX';
if(index($peer->{'peer'}, ':') >= 0) {
$peer->{'type'} = 'INET';
}
}
- push @{$peers}, $peer;
+ return $peer;
} else {
my $type = 'UNIX';
if(index($peer, ':') >= 0) {
$type = 'INET';
}
- push @{$peers}, { 'peer' => "".$peer, type => $type, name => "".$peer };
+ return({ 'peer' => ''.$peer, type => $type, name => ''.$peer });
}
}
}
@@ -1417,62 +1442,40 @@ sub _get_peers {
if(index($peer, ':') >= 0) {
$type = 'INET';
}
- push @{$peers}, { 'peer' => "".$peer, type => $type, name => "".$name };
+ return({ 'peer' => ''.$peer, type => $type, name => ''.$name });
}
} else {
- confess("type ".(ref $self->{'peer'})." is not supported for peer option");
+ confess('type '.(ref $self->{'peer'}).' is not supported for peer option');
}
}
if(defined $self->{'socket'}) {
- my $name = $self->{'name'} || "".$self->{'socket'};
- push @{$peers}, { 'peer' => "".$self->{'socket'}, type => 'UNIX', name => $name };
+ my $name = $self->{'name'} || ''.$self->{'socket'};
+ return({ 'peer' => ''.$self->{'socket'}, type => 'UNIX', name => $name });
}
if(defined $self->{'server'}) {
- my $name = $self->{'name'} || "".$self->{'server'};
- push @{$peers}, { 'peer' => "".$self->{'server'}, type => 'INET', name => $name };
+ my $name = $self->{'name'} || ''.$self->{'server'};
+ return({ 'peer' => ''.$self->{'server'}, type => 'INET', name => $name });
}
# check if we got a peer
- if(scalar @{$peers} == 0) {
- croak('please specify at least one peer, socket or server');
- }
-
- # clean up
- delete $options{'peer'};
- delete $options{'socket'};
- delete $options{'server'};
-
- return $peers;
+ croak('please specify a peer');
}
########################################
sub _lowercase_and_verify_options {
- my $self = shift;
- my $opts = shift;
+ my($self, $opts) = @_;
my $return = {};
- # list of allowed options
- my $allowed_options = {
- 'addpeer' => 1,
- 'backend' => 1,
- 'columns' => 1,
- 'deepcopy' => 1,
- 'header' => 1,
- 'limit' => 1,
- 'limit_start' => 1,
- 'limit_length' => 1,
- 'rename' => 1,
- 'slice' => 1,
- 'sum' => 1,
- 'callbacks' => 1,
- };
+ # make keys lowercase
+ %{$return} = map { lc($_) => $opts->{$_} } keys %{$opts};
- for my $key (keys %{$opts}) {
- if($self->{'warnings'} and !defined $allowed_options->{lc $key}) {
- carp("unknown option used: $key - please use only: ".join(", ", keys %{$allowed_options}));
+ if($self->{'warnings'}) {
+ for my $key (keys %{$return}) {
+ if(!defined $allowed_options->{$key}) {
+ carp("unknown option used: $key - please use only: ".join(', ', keys %{$allowed_options}));
+ }
}
- $return->{lc $key} = $opts->{$key};
}
# set limits
@@ -1494,10 +1497,7 @@ sub _lowercase_and_verify_options {
########################################
sub _log_statement {
- my $self = shift;
- my $statement = shift;
- my $opt = shift;
- my $limit = shift;
+ my($self, $statement, $opt, $limit) = @_;
my $d = Data::Dumper->new([$opt]);
$d->Indent(0);
my $optstring = $d->Dump;
@@ -1517,32 +1517,6 @@ sub _log_statement {
1;
-=head1 EXAMPLES
-
-=head2 Multibackend Configuration
-
- use Monitoring::Livestatus;
- my $ml = Monitoring::Livestatus->new(
- name => 'multiple connector',
- verbose => 0,
- keepalive => 1,
- peer => [
- {
- name => 'DMZ Monitoring',
- peer => '50.50.50.50:9999',
- },
- {
- name => 'Local Monitoring',
- peer => '/tmp/livestatus.socket',
- },
- {
- name => 'Special Monitoring',
- peer => '100.100.100.100:9999',
- }
- ],
- );
- my $hosts = $ml->selectall_arrayref("GET hosts");
-
=head1 SEE ALSO
For more information about the query syntax and the livestatus plugin installation
@@ -1550,11 +1524,11 @@ see the Livestatus page: http://mathias-kettner.de/checkmk_livestatus.html
=head1 AUTHOR
-Sven Nierlein, E<lt>nierlein at cpan.orgE<gt>
+Sven Nierlein, 2009-present, <sven at nierlein.org>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2009 by Sven Nierlein
+Copyright (C) by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/lib/Monitoring/Livestatus/INET.pm b/lib/Monitoring/Livestatus/INET.pm
index 2c01ebc..90546c9 100644
--- a/lib/Monitoring/Livestatus/INET.pm
+++ b/lib/Monitoring/Livestatus/INET.pm
@@ -1,12 +1,11 @@
package Monitoring::Livestatus::INET;
+use parent 'Monitoring::Livestatus';
-use 5.000000;
use strict;
use warnings;
-use IO::Socket::INET;
+use IO::Socket::INET ();
use Socket qw(IPPROTO_TCP TCP_NODELAY);
-use Carp;
-use base "Monitoring::Livestatus";
+use Carp qw/confess croak/;
=head1 NAME
@@ -30,9 +29,9 @@ be a the C<server> specification. Use either socker OR server.
=cut
sub new {
- my $class = shift;
- unshift(@_, "peer") if scalar @_ == 1;
- my(%options) = @_;
+ my($class, @args) = @_;
+ unshift(@args, "peer") if scalar @args == 1;
+ my(%options) = @args;
$options{'name'} = $options{'peer'} unless defined $options{'name'};
$options{'backend'} = $class;
@@ -54,16 +53,16 @@ sub _open {
my $self = shift;
my $sock;
+ my $remaining = alarm($self->{'connect_timeout'});
eval {
local $SIG{'ALRM'} = sub { die("connection timeout"); };
- alarm($self->{'connect_timeout'});
$sock = IO::Socket::INET->new(
PeerAddr => $self->{'peer'},
- Type => SOCK_STREAM,
+ Type => IO::Socket::INET::SOCK_STREAM,
Timeout => $self->{'connect_timeout'},
);
- if(!defined $sock or !$sock->connected()) {
- my $msg = "failed to connect to $self->{'peer'} :$!";
+ if(!defined $sock || !$sock->connected()) {
+ my $msg = "failed to connect to $self->{'peer'}: $!";
if($self->{'errors_are_fatal'}) {
croak($msg);
}
@@ -73,15 +72,11 @@ sub _open {
return;
}
- if(defined $self->{'query_timeout'}) {
- # set timeout
- $sock->timeout($self->{'query_timeout'});
- }
-
setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1);
};
alarm(0);
+ alarm($remaining) if $remaining;
if($@) {
$Monitoring::Livestatus::ErrorCode = 500;
@@ -89,6 +84,11 @@ sub _open {
return;
}
+ if(defined $self->{'query_timeout'}) {
+ # set timeout
+ $sock->timeout($self->{'query_timeout'});
+ }
+
return($sock);
}
@@ -107,11 +107,11 @@ sub _close {
=head1 AUTHOR
-Sven Nierlein, E<lt>nierlein at cpan.orgE<gt>
+Sven Nierlein, 2009-present, <sven at nierlein.org>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2009 by Sven Nierlein
+Copyright (C) by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/lib/Monitoring/Livestatus/MULTI.pm b/lib/Monitoring/Livestatus/MULTI.pm
deleted file mode 100644
index 20201bf..0000000
--- a/lib/Monitoring/Livestatus/MULTI.pm
+++ /dev/null
@@ -1,922 +0,0 @@
-package Monitoring::Livestatus::MULTI;
-
-use 5.000000;
-use strict;
-use warnings;
-use Carp;
-use Data::Dumper;
-use Config;
-use Time::HiRes qw/gettimeofday tv_interval/;
-use Scalar::Util qw/looks_like_number/;
-use Monitoring::Livestatus;
-use base "Monitoring::Livestatus";
-
-=head1 NAME
-
-Monitoring::Livestatus::MULTI - connector with multiple peers
-
-=head1 SYNOPSIS
-
- use Monitoring::Livestatus;
- my $nl = Monitoring::Livestatus::MULTI->new( qw{nagioshost1:9999 nagioshost2:9999 /var/spool/nagios/live.socket} );
- my $hosts = $nl->selectall_arrayref("GET hosts");
-
-=head1 CONSTRUCTOR
-
-=head2 new ( [ARGS] )
-
-Creates an C<Monitoring::Livestatus::MULTI> object. C<new> takes at least the server.
-Arguments are the same as in L<Monitoring::Livestatus>.
-
-=cut
-
-sub new {
- my $class = shift;
- unshift(@_, "peer") if scalar @_ == 1;
- my(%options) = @_;
-
- $options{'backend'} = $class;
- my $self = Monitoring::Livestatus->new(%options);
- bless $self, $class;
-
- if(!defined $self->{'peers'}) {
- $self->{'peer'} = $self->_get_peers();
-
- # set our peer(s) from the options
- my %peer_options;
- my $peers;
- for my $opt_key (keys %options) {
- $peer_options{$opt_key} = $options{$opt_key};
- }
- $peer_options{'errors_are_fatal'} = 0;
- for my $peer (@{$self->{'peer'}}) {
- $peer_options{'name'} = $peer->{'name'};
- $peer_options{'peer'} = $peer->{'peer'};
- delete $peer_options{'socket'};
- delete $peer_options{'server'};
-
- if($peer->{'type'} eq 'UNIX') {
- push @{$peers}, new Monitoring::Livestatus::UNIX(%peer_options);
- }
- elsif($peer->{'type'} eq 'INET') {
- push @{$peers}, new Monitoring::Livestatus::INET(%peer_options);
- }
- }
- $self->{'peers'} = $peers;
- delete $self->{'socket'};
- delete $self->{'server'};
- }
-
- if(!defined $self->{'peers'}) {
- croak('please specify at least one peer, socket or server');
- }
-
- # dont use threads with only one peer
- if(scalar @{$self->{'peers'}} == 1) { $self->{'use_threads'} = 0; }
-
- # check for threads support
- if(!defined $self->{'use_threads'}) {
- $self->{'use_threads'} = 0;
- if($Config{useithreads}) {
- $self->{'use_threads'} = 1;
- }
- }
- if($self->{'use_threads'}) {
- eval {
- require threads;
- require Thread::Queue;
- };
- if($@) {
- $self->{'use_threads'} = 0;
- $self->{'logger'}->debug('error initializing threads: '.$@) if defined $self->{'logger'};
- } else {
- $self->_start_worker;
- }
- }
-
- # initialize peer keys
- $self->{'peer_by_key'} = {};
- $self->{'peer_by_addr'} = {};
- for my $peer (@{$self->{'peers'}}) {
- $self->{'peer_by_key'}->{$peer->peer_key} = $peer;
- $self->{'peer_by_addr'}->{$peer->peer_addr} = $peer;
- }
-
- $self->{'name'} = 'multiple connector' unless defined $self->{'name'};
- $self->{'logger'}->debug('initialized Monitoring::Livestatus::MULTI '.($self->{'use_threads'} ? 'with' : 'without' ).' threads') if $self->{'verbose'};
-
- return $self;
-}
-
-
-########################################
-
-=head1 METHODS
-
-=head2 do
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub do {
- my $self = shift;
- my $opts = $self->_lowercase_and_verify_options($_[1]);
- my $t0 = [gettimeofday];
-
- $self->_do_on_peers("do", $opts->{'backends'}, @_);
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for do('.$_[0].') in total') if $self->{'verbose'};
- return 1;
-}
-
-
-########################################
-
-=head2 selectall_arrayref
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectall_arrayref {
- my $self = shift;
- my $opts = $self->_lowercase_and_verify_options($_[1]);
- my $t0 = [gettimeofday];
-
- $self->_log_statement($_[0], $opts, 0) if $self->{'verbose'};
-
- my $return = $self->_merge_answer($self->_do_on_peers("selectall_arrayref", $opts->{'backends'}, @_));
- my $elapsed = tv_interval ( $t0 );
- if($self->{'verbose'}) {
- my $total_results = 0;
- $total_results = scalar @{$return} if defined $return;
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectall_arrayref() in total, results: '.$total_results);
- }
-
- return $return;
-}
-
-
-########################################
-
-=head2 selectall_hashref
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectall_hashref {
- my $self = shift;
- my $opts = $self->_lowercase_and_verify_options($_[2]);
- my $t0 = [gettimeofday];
-
- my $return = $self->_merge_answer($self->_do_on_peers("selectall_hashref", $opts->{'backends'}, @_));
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectall_hashref() in total') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-
-=head2 selectcol_arrayref
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectcol_arrayref {
- my $self = shift;
- my $opts = $self->_lowercase_and_verify_options($_[1]);
- my $t0 = [gettimeofday];
-
- my $return = $self->_merge_answer($self->_do_on_peers("selectcol_arrayref", $opts->{'backends'}, @_));
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectcol_arrayref() in total') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-
-=head2 selectrow_array
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectrow_array {
- my $self = shift;
- my $statement = $_[0];
- my $opts = $self->_lowercase_and_verify_options($_[1]);
- my $t0 = [gettimeofday];
- my @return;
-
- if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
- @return = @{$self->_sum_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_))};
- } else {
- if($self->{'warnings'}) {
- carp("selectrow_arrayref without Stats on multi backend will not work as expected!");
- }
- my $rows = $self->_merge_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
- @return = @{$rows} if defined $rows;
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_array() in total') if $self->{'verbose'};
-
- return @return;
-}
-
-
-########################################
-
-=head2 selectrow_arrayref
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectrow_arrayref {
- my $self = shift;
- my $statement = $_[0];
- my $opts = $self->_lowercase_and_verify_options($_[1]);
- my $t0 = [gettimeofday];
- my $return;
-
- if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
- $return = $self->_sum_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
- } else {
- if($self->{'warnings'}) {
- carp("selectrow_arrayref without Stats on multi backend will not work as expected!");
- }
- my $rows = $self->_merge_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
- $return = $rows->[0] if defined $rows->[0];
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_arrayref() in total') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-
-=head2 selectrow_hashref
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectrow_hashref {
- my $self = shift;
- my $statement = $_[0];
- my $opts = $self->_lowercase_and_verify_options($_[1]);
-
- my $t0 = [gettimeofday];
-
- my $return;
-
- if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
- $return = $self->_sum_answer($self->_do_on_peers("selectrow_hashref", $opts->{'backends'}, @_));
- } else {
- if($self->{'warnings'}) {
- carp("selectrow_hashref without Stats on multi backend will not work as expected!");
- }
- $return = $self->_merge_answer($self->_do_on_peers("selectrow_hashref", $opts->{'backends'}, @_));
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_hashref() in total') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-
-=head2 selectscalar_value
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub selectscalar_value {
- my $self = shift;
- my $statement = $_[0];
- my $opts = $self->_lowercase_and_verify_options($_[1]);
-
- my $t0 = [gettimeofday];
-
- my $return;
-
- if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
- return $self->_sum_answer($self->_do_on_peers("selectscalar_value", $opts->{'backends'}, @_));
- } else {
- if($self->{'warnings'}) {
- carp("selectscalar_value without Stats on multi backend will not work as expected!");
- }
- my $rows = $self->_merge_answer($self->_do_on_peers("selectscalar_value", $opts->{'backends'}, @_));
-
- $return = $rows->[0] if defined $rows->[0];
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectscalar_value() in total') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-
-=head2 errors_are_fatal
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub errors_are_fatal {
- my $self = shift;
- my $value = shift;
- return $self->_change_setting('errors_are_fatal', $value);
-}
-
-
-########################################
-
-=head2 warnings
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub warnings {
- my $self = shift;
- my $value = shift;
- return $self->_change_setting('warnings', $value);
-}
-
-
-########################################
-
-=head2 verbose
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub verbose {
- my $self = shift;
- my $value = shift;
- return $self->_change_setting('verbose', $value);
-}
-
-
-########################################
-
-=head2 peer_addr
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub peer_addr {
- my $self = shift;
-
- my @addrs;
- for my $peer (@{$self->{'peers'}}) {
- push @addrs, $peer->peer_addr;
- }
-
- return wantarray ? @addrs : undef;
-}
-
-
-########################################
-
-=head2 peer_name
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub peer_name {
- my $self = shift;
-
- my @names;
- for my $peer (@{$self->{'peers'}}) {
- push @names, $peer->peer_name;
- }
-
- return wantarray ? @names : $self->{'name'};
-}
-
-
-########################################
-
-=head2 peer_key
-
-See L<Monitoring::Livestatus> for more information.
-
-=cut
-
-sub peer_key {
- my $self = shift;
-
- my @keys;
- for my $peer (@{$self->{'peers'}}) {
- push @keys, $peer->peer_key;
- }
-
- return wantarray ? @keys : $self->{'key'};
-}
-
-
-########################################
-
-=head2 disable
-
- $ml->disable()
-
-disables this connection, returns the last state.
-
-=cut
-sub disable {
- my $self = shift;
- my $peer_key = shift;
- if(!defined $peer_key) {
- for my $peer (@{$self->{'peers'}}) {
- $peer->disable();
- }
- return 1;
- } else {
- my $peer = $self->_get_peer_by_key($peer_key);
- my $prev = $peer->{'disabled'};
- $peer->{'disabled'} = 1;
- return $prev;
- }
-}
-
-
-########################################
-
-=head2 enable
-
- $ml->enable()
-
-enables this connection, returns the last state.
-
-=cut
-sub enable {
- my $self = shift;
- my $peer_key = shift;
- if(!defined $peer_key) {
- for my $peer (@{$self->{'peers'}}) {
- $peer->enable();
- }
- return 1;
- } else {
- my $peer = $self->_get_peer_by_key($peer_key);
- my $prev = $peer->{'disabled'};
- $peer->{'disabled'} = 0;
- return $prev;
- }
-}
-
-########################################
-# INTERNAL SUBS
-########################################
-
-sub _change_setting {
- my $self = shift;
- my $key = shift;
- my $value = shift;
- my $old = $self->{$key};
-
- # set new value
- if(defined $value) {
- $self->{$key} = $value;
- for my $peer (@{$self->{'peers'}}) {
- $peer->{$key} = $value;
- }
-
- # restart workers
- if($self->{'use_threads'}) {
- _stop_worker();
- $self->_start_worker();
- }
- }
-
- return $old;
-}
-
-
-########################################
-sub _start_worker {
- my $self = shift;
-
- # create job transports
- $self->{'WorkQueue'} = Thread::Queue->new;
- $self->{'WorkResults'} = Thread::Queue->new;
-
- # set signal handler before thread is started
- # otherwise they would be killed when started
- # and stopped immediately after start
- $SIG{'USR1'} = sub { threads->exit(); };
-
- # start worker threads
- our %threads;
- my $threadcount = scalar @{$self->{'peers'}};
- for(my $x = 0; $x < $threadcount; $x++) {
- $self->{'threads'}->[$x] = threads->new(\&_worker_thread, $self->{'peers'}, $self->{'WorkQueue'}, $self->{'WorkResults'}, $self->{'logger'});
- }
-
- # restore sig handler as it was only for the threads
- $SIG{'USR1'} = 'DEFAULT';
- return;
-}
-
-
-########################################
-sub _stop_worker {
- # try to kill our threads safely
- eval {
- for my $thr (threads->list()) {
- $thr->kill('USR1')->detach();
- }
- };
- return;
-}
-
-
-########################################
-sub _worker_thread {
- local $SIG{'USR1'} = sub { threads->exit(); };
-
- my $peers = shift;
- my $workQueue = shift;
- my $workResults = shift;
- my $logger = shift;
-
- while (my $job = $workQueue->dequeue) {
- my $erg;
- eval {
- $erg = _do_wrapper($peers->[$job->{'peer'}], $job->{'sub'}, $logger, @{$job->{'opts'}});
- };
- if($@) {
- warn("Error in Thread ".$job->{'peer'}." :".$@);
- $job->{'logger'}->error("Error in Thread ".$job->{'peer'}." :".$@) if defined $job->{'logger'};
- };
- $workResults->enqueue({ peer => $job->{'peer'}, result => $erg });
- }
- return;
-}
-
-
-########################################
-sub _do_wrapper {
- my $peer = shift;
- my $sub = shift;
- my $logger = shift;
- my @opts = @_;
-
- my $t0 = [gettimeofday];
-
- my $data = $peer->$sub(@opts);
-
- my $elapsed = tv_interval ( $t0 );
- $logger->debug(sprintf('%.4f', $elapsed).' sec for fetching data on '.$peer->peer_name.' ('.$peer->peer_addr.')') if defined $logger;
-
- $Monitoring::Livestatus::ErrorCode = 0 unless defined $Monitoring::Livestatus::ErrorCode;
- $Monitoring::Livestatus::ErrorMessage = '' unless defined $Monitoring::Livestatus::ErrorMessage;
- my $return = {
- 'msg' => $Monitoring::Livestatus::ErrorMessage,
- 'code' => $Monitoring::Livestatus::ErrorCode,
- 'data' => $data,
- };
- return $return;
-}
-
-
-########################################
-sub _do_on_peers {
- my $self = shift;
- my $sub = shift;
- my $backends = shift;
- my @opts = @_;
- my $statement = $opts[0];
- my $use_threads = $self->{'use_threads'};
- my $t0 = [gettimeofday];
-
- my $return;
- my %codes;
- my %messages;
- my $query_options;
- if($sub eq 'selectall_hashref') {
- $query_options = $self->_lowercase_and_verify_options($opts[2]);
- } else {
- $query_options = $self->_lowercase_and_verify_options($opts[1]);
- }
-
- # which peers affected?
- my @peers;
- if(defined $backends) {
- my @backends;
- if(ref $backends eq '') {
- push @backends, $backends;
- }
- elsif(ref $backends eq 'ARRAY') {
- @backends = @{$backends};
- } else {
- croak("unsupported type for backend: ".ref($backends));
- }
-
- for my $key (@backends) {
- my $backend = $self->_get_peer_by_key($key);
- push @peers, $backend unless $backend->{'disabled'};
- }
- } else {
- # use all backends
- @peers = @{$self->{'peers'}};
- }
-
- # its faster without threads for only one peer
- if(scalar @peers <= 1) { $use_threads = 0; }
-
- # if we have limits set, we cannot use threads
- if(defined $query_options->{'limit_start'}) { $use_threads = 0; }
-
- if($use_threads) {
- # use the threaded variant
- $self->{'logger'}->debug('using threads') if $self->{'verbose'};
-
- my $peers_to_use;
- for my $peer (@peers) {
- if($peer->{'disabled'}) {
- # dont send any query
- }
- elsif($peer->marked_bad) {
- warn($peer->peer_name.' ('.$peer->peer_key.') is marked bad') if $self->{'verbose'};
- }
- else {
- $peers_to_use->{$peer->peer_key} = 1;
- }
- }
- my $x = 0;
- for my $peer (@{$self->{'peers'}}) {
- if(defined $peers_to_use->{$peer->peer_key}) {
- my $job = {
- 'peer' => $x,
- 'sub' => $sub,
- 'opts' => \@opts,
- };
- $self->{'WorkQueue'}->enqueue($job);
- }
- $x++;
- }
-
- for(my $x = 0; $x < scalar keys %{$peers_to_use}; $x++) {
- my $result = $self->{'WorkResults'}->dequeue;
- my $peer = $self->{'peers'}->[$result->{'peer'}];
- if(defined $result->{'result'}) {
- push @{$codes{$result->{'result'}->{'code'}}}, { 'peer' => $peer->peer_key, 'msg' => $result->{'result'}->{'msg'} };
- $return->{$peer->peer_key} = $result->{'result'}->{'data'};
- } else {
- warn("undefined result for: $statement");
- }
- }
- } else {
- $self->{'logger'}->debug('not using threads') if $self->{'verbose'};
- for my $peer (@peers) {
- if($peer->{'disabled'}) {
- # dont send any query
- }
- elsif($peer->marked_bad) {
- warn($peer->peer_name.' ('.$peer->peer_key.') is marked bad') if $self->{'verbose'};
- } else {
- my $erg = _do_wrapper($peer, $sub, $self->{'logger'}, @opts);
- $return->{$peer->peer_key} = $erg->{'data'};
- push @{$codes{$erg->{'code'}}}, { 'peer' => $peer, 'msg' => $erg->{'msg'} };
-
- # compute limits
- if(defined $query_options->{'limit_length'} and $peer->{'meta_data'}->{'result_count'}) {
- last;
- }
- # set a new start if we had rows already
- if(defined $query_options->{'limit_start'}) {
- $query_options->{'limit_start'} = $query_options->{'limit_start'} - $peer->{'meta_data'}->{'row_count'};
- }
- }
- }
- }
-
-
- # check if we different result stati
- undef $Monitoring::Livestatus::ErrorMessage;
- $Monitoring::Livestatus::ErrorCode = 0;
- my @codes = sort keys %codes;
- if(scalar @codes > 1) {
- # got different results for our backends
- if($self->{'verbose'}) {
- $self->{'logger'}->warn("got different result stati: ".Dumper(\%codes));
- }
- } else {
- # got same result codes for all backend
- }
-
- my $failed = 0;
- my $code = $codes[0];
- if(defined $code and $code >= 300) {
- $failed = 1;
- }
-
- if($failed) {
- my $msg = $codes{$code}->[0]->{'msg'};
- $self->{'logger'}->debug("same: $code -> $msg") if $self->{'verbose'};
- $Monitoring::Livestatus::ErrorMessage = $msg;
- $Monitoring::Livestatus::ErrorCode = $code;
- if($self->{'errors_are_fatal'}) {
- croak("ERROR ".$code." - ".$Monitoring::Livestatus::ErrorMessage." in query:\n'".$statement."'\n");
- }
- return;
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for fetching all data') if $self->{'verbose'};
-
- # deep copy result?
- if($use_threads
- and (
- (defined $query_options->{'deepcopy'} and $query_options->{'deepcopy'} == 1)
- or
- (defined $self->{'deepcopy'} and $self->{'deepcopy'} == 1)
- )
- ) {
- # result has to be cloned to avoid "Invalid value for shared scalar" error
-
- $return = $self->_clone($return, $self->{'logger'});
- }
-
- return($return);
-}
-
-
-########################################
-sub _merge_answer {
- my $self = shift;
- my $data = shift;
- my $return;
-
- my $t0 = [gettimeofday];
-
- # iterate over original peers to retain order
- for my $peer (@{$self->{'peers'}}) {
- my $key = $peer->peer_key;
- next if !defined $data->{$key};
-
- if(ref $data->{$key} eq 'ARRAY') {
- $return = [] unless defined $return;
- $return = [ @{$return}, @{$data->{$key}} ];
- } elsif(ref $data->{$key} eq 'HASH') {
- $return = {} unless defined $return;
- $return = { %{$return}, %{$data->{$key}} };
- } else {
- push @{$return}, $data->{$key};
- }
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for merging data') if $self->{'verbose'};
-
- return($return);
-}
-
-
-########################################
-sub _sum_answer {
- my $self = shift;
- my $data = shift;
- my $return;
- my $t0 = [gettimeofday];
- for my $peername (keys %{$data}) {
- if(ref $data->{$peername} eq 'HASH') {
- for my $key (keys %{$data->{$peername}}) {
- if(!defined $return->{$key}) {
- $return->{$key} = $data->{$peername}->{$key};
- } elsif(looks_like_number($data->{$peername}->{$key})) {
- $return->{$key} += $data->{$peername}->{$key};
- }
- }
- }
- elsif(ref $data->{$peername} eq 'ARRAY') {
- my $x = 0;
- for my $val (@{$data->{$peername}}) {
- if(!defined $return->[$x]) {
- $return->[$x] = $data->{$peername}->[$x];
- } else {
- $return->[$x] += $data->{$peername}->[$x];
- }
- $x++;
- }
- } elsif(defined $data->{$peername}) {
- $return = 0 unless defined $return;
- next unless defined $data->{$peername};
- $return += $data->{$peername};
- }
- }
-
- my $elapsed = tv_interval ( $t0 );
- $self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for summarizing data') if $self->{'verbose'};
-
- return $return;
-}
-
-
-########################################
-sub _clone {
- my $self = shift;
- my $data = shift;
- my $logger = shift;
- my $t0 = [gettimeofday];
-
- my $return;
- if(ref $data eq '') {
- $return = $data;
- }
- elsif(ref $data eq 'ARRAY') {
- $return = [];
- for my $dat (@{$data}) {
- push @{$return}, $self->_clone($dat);
- }
- }
- elsif(ref $data eq 'HASH') {
- $return = {};
- for my $key (keys %{$data}) {
- $return->{$key} = $self->_clone($data->{$key});
- }
- }
- else {
- croak("cant clone: ".(ref $data));
- }
-
- my $elapsed = tv_interval ( $t0 );
- $logger->debug(sprintf('%.4f', $elapsed).' sec for cloning data') if defined $logger;
-
- return $return;
-}
-
-
-########################################
-sub _get_peer_by_key {
- my $self = shift;
- my $key = shift;
-
- return unless defined $key;
- return unless defined $self->{'peer_by_key'}->{$key};
-
- return $self->{'peer_by_key'}->{$key};
-}
-
-
-########################################
-sub _get_peer_by_addr {
- my $self = shift;
- my $addr = shift;
-
- return unless defined $addr;
- return unless defined $self->{'peer_by_addr'}->{$addr};
-
- return $self->{'peer_by_addr'}->{$addr};
-}
-
-
-########################################
-
-END {
- # try to kill our threads safely
- _stop_worker();
-}
-
-########################################
-
-1;
-
-=head1 AUTHOR
-
-Sven Nierlein, E<lt>nierlein at cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2009 by Sven Nierlein
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-
-__END__
diff --git a/lib/Monitoring/Livestatus/UNIX.pm b/lib/Monitoring/Livestatus/UNIX.pm
index 63136ce..c0802d3 100644
--- a/lib/Monitoring/Livestatus/UNIX.pm
+++ b/lib/Monitoring/Livestatus/UNIX.pm
@@ -1,11 +1,10 @@
package Monitoring::Livestatus::UNIX;
+use parent 'Monitoring::Livestatus';
-use 5.000000;
use strict;
use warnings;
-use IO::Socket::UNIX;
-use Carp;
-use base "Monitoring::Livestatus";
+use IO::Socket::UNIX ();
+use Carp qw/confess croak/;
=head1 NAME
@@ -29,9 +28,9 @@ be a the C<socket> specification. Use either socker OR server.
=cut
sub new {
- my $class = shift;
- unshift(@_, "peer") if scalar @_ == 1;
- my(%options) = @_;
+ my($class, at args) = @_;
+ unshift(@args, "peer") if scalar @args == 1;
+ my(%options) = @args;
$options{'name'} = $options{'peer'} unless defined $options{'name'};
$options{'backend'} = $class;
@@ -61,17 +60,30 @@ sub _open {
$Monitoring::Livestatus::ErrorMessage = $msg;
return;
}
- my $sock = IO::Socket::UNIX->new(
+ my $sock;
+ my $remaining = alarm($self->{'connect_timeout'});
+ eval {
+ local $SIG{'ALRM'} = sub { die("connection timeout"); };
+ $sock = IO::Socket::UNIX->new(
Peer => $self->{'peer'},
- Type => SOCK_STREAM,
- );
- if(!defined $sock or !$sock->connected()) {
- my $msg = "failed to connect to $self->{'peer'} :$!";
- if($self->{'errors_are_fatal'}) {
- croak($msg);
+ Type => IO::Socket::UNIX::SOCK_STREAM,
+ );
+ if(!defined $sock || !$sock->connected()) {
+ my $msg = "failed to connect to $self->{'peer'}: $!";
+ if($self->{'errors_are_fatal'}) {
+ croak($msg);
+ }
+ $Monitoring::Livestatus::ErrorCode = 500;
+ $Monitoring::Livestatus::ErrorMessage = $msg;
+ return;
}
+ };
+ alarm(0);
+ alarm($remaining) if $remaining;
+
+ if($@) {
$Monitoring::Livestatus::ErrorCode = 500;
- $Monitoring::Livestatus::ErrorMessage = $msg;
+ $Monitoring::Livestatus::ErrorMessage = $@;
return;
}
@@ -98,11 +110,11 @@ sub _close {
=head1 AUTHOR
-Sven Nierlein, E<lt>nierlein at cpan.orgE<gt>
+Sven Nierlein, 2009-present, <sven at nierlein.org>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2009 by Sven Nierlein
+Copyright (C) by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/t/01-Monitoring-Livestatus-basic_tests.t b/t/01-Monitoring-Livestatus-basic_tests.t
index aeac3da..695b008 100644
--- a/t/01-Monitoring-Livestatus-basic_tests.t
+++ b/t/01-Monitoring-Livestatus-basic_tests.t
@@ -14,7 +14,7 @@ BEGIN {
plan skip_all => 'no sockets on windows';
}
else {
- plan tests => 35;
+ plan tests => 29;
}
}
@@ -71,30 +71,6 @@ 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,
diff --git a/t/02-Monitoring-Livestatus-internals.t b/t/02-Monitoring-Livestatus-internals.t
index addb3d2..6926927 100644
--- a/t/02-Monitoring-Livestatus-internals.t
+++ b/t/02-Monitoring-Livestatus-internals.t
@@ -85,9 +85,9 @@ my @expected_keys1 = (
'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($statement, $got_keys1) = Monitoring::Livestatus::extract_keys_from_stats_statement($stats_query1);
+is_deeply($got_keys1, \@expected_keys1, 'statsAnd, statsOr query keys')
+ or ( diag('got keys: '.Dumper($got_keys1)) );
#########################
@@ -125,9 +125,9 @@ my @expected_keys2 = (
'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($statement, $got_keys2) = Monitoring::Livestatus::extract_keys_from_stats_statement($stats_query2);
+is_deeply($got_keys2, \@expected_keys2, 'stats query keys2')
+ or ( diag('got keys: '.Dumper($got_keys2)) );
#########################
diff --git a/t/03-Monitoring-Livestatus-MULTI-internals.t b/t/03-Monitoring-Livestatus-MULTI-internals.t
deleted file mode 100644
index 4cd3275..0000000
--- a/t/03-Monitoring-Livestatus-MULTI-internals.t
+++ /dev/null
@@ -1,215 +0,0 @@
-#!/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');
diff --git a/t/20-Monitoring-Livestatus-test_socket.t b/t/20-Monitoring-Livestatus-test_socket.t
index 3c6380b..ab37e44 100644
--- a/t/20-Monitoring-Livestatus-test_socket.t
+++ b/t/20-Monitoring-Livestatus-test_socket.t
@@ -16,6 +16,9 @@ BEGIN {
elsif( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
+ elsif( $^V ge v5.24 ) {
+ plan skip_all => 'JSON::XS will not work in threaded perl >= 5.24';
+ }
else{
plan tests => 109
}
diff --git a/t/23-Monitoring-Livestatus-BigData.t b/t/23-Monitoring-Livestatus-BigData.t
new file mode 100644
index 0000000..7107c10
--- /dev/null
+++ b/t/23-Monitoring-Livestatus-BigData.t
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+
+#########################
+
+use strict;
+use Test::More tests => 14;
+BEGIN { use_ok('Monitoring::Livestatus') };
+
+my $testport = 60123;
+my $testresults = $ARGV[0] || 5;
+
+#########################
+# create object with single arg
+my $ml = Monitoring::Livestatus->new('localhost:'.$testport);
+isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus->new()');
+
+#########################
+# prepare testfile
+my $testfile = '/tmp/testresult.json';
+open(my $fh, '>', $testfile.'.data') or die($testfile.'.data: '.$!);
+print $fh "[";
+for my $x (1..$testresults) {
+ printf($fh '["Test Host %d","some test pluginoutput............................................",1],%s', $x, "\n");
+}
+print $fh "]\n";
+close($fh);
+ok(-f $testfile, "testfile: ".$testfile.".data written");
+
+chomp(my $size = `du -h $testfile.data`);
+ok($size, $size);
+
+chomp(my $bytes = `du -b $testfile.data | awk '{print \$1}'`);
+ok($bytes, 'testfile has '.$bytes.' bytes');
+
+open($fh, '>', $testfile.'.head') or die($testfile.'.head: '.$!);
+printf($fh "200 %12d\n", $bytes);
+close($fh);
+`cat $testfile.head $testfile.data > $testfile`;
+unlink($testfile.'.head', $testfile.'.data');
+
+##########################################################
+my $mem_start = get_memory_usage();
+ok($mem_start, sprintf('memory at start: %.2f MB', $mem_start/1024));
+
+##########################################################
+# start netcat
+`netcat -vvv -w 3 -l -p $testport >/tmp/blah 2>&1 < $testfile &`;
+sleep(0.1);
+ok(1, "netcat started");
+
+##########################################################
+my $result = $ml->selectall_arrayref(
+ "GET hosts\nColumns: name plugin_output status", {
+ Slice => {},
+ }
+ );
+is(ref $result, 'ARRAY', 'result is an array');
+is(scalar @{$result}, $testresults, 'result has right number');
+is(ref $result->[$testresults-1], 'HASH', 'result contains hashes');
+is($result->[$testresults-1]->{'name'}, 'Test Host '.$testresults, 'result contains all hosts');
+
+
+##########################################################
+my $mem_end = get_memory_usage();
+ok($mem_end, sprintf('memory at end: %.2f MB', $mem_end/1024));
+my $delta = $mem_end - $mem_start;
+ok($delta, sprintf('memory delta: %.2f MB', $delta/1024));
+ok($delta, sprintf('memory usage per entry: %d B', $delta*1024/$testresults));
+
+##########################################################
+# returns memory usage in kB
+sub get_memory_usage {
+ my($pid) = @_;
+ $pid = $$ unless defined $pid;
+
+ my $rsize;
+ open(my $ph, '-|', "ps -p $pid -o rss") or die("ps failed: $!");
+ while(my $line = <$ph>) {
+ if($line =~ m/(\d+)/mx) {
+ $rsize = sprintf("%.2f", $1);
+ }
+ }
+ CORE::close($ph);
+ return($rsize);
+}
diff --git a/t/30-Monitoring-Livestatus-live-test.t b/t/30-Monitoring-Livestatus-live-test.t
index 6a82d36..a4aaa79 100644
--- a/t/30-Monitoring-Livestatus-live-test.t
+++ b/t/30-Monitoring-Livestatus-live-test.t
@@ -10,7 +10,7 @@ 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 );
+ plan( tests => 333 );
}
# set an alarm
@@ -23,6 +23,8 @@ $SIG{ALRM} = sub {
alarm(120);
use_ok('Monitoring::Livestatus');
+use_ok('Monitoring::Livestatus::INET');
+use_ok('Monitoring::Livestatus::UNIX');
#########################
my $line_seperator = 10;
@@ -66,38 +68,6 @@ my $objects_to_test = {
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 = {
@@ -109,12 +79,12 @@ my $expected_keys = {
],
'comments' => [
'__all_from_hosts__', '__all_from_services__',
- 'author','comment','entry_time','entry_type','expire_time','expires', 'id','persistent',
+ 'author','comment','entry_time','entry_type','expire_time','expires', 'id','is_service','persistent',
'source','type'
],
'contacts' => [
'address1','address2','address3','address4','address5','address6','alias',
- 'can_submit_commands','custom_variable_names','custom_variable_values','email',
+ 'can_submit_commands','custom_variable_names','custom_variable_values','email','custom_variables',
'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'
@@ -122,7 +92,7 @@ my $expected_keys = {
'contactgroups' => [ 'name', 'alias', 'members' ],
'downtimes' => [
'__all_from_hosts__', '__all_from_services__',
- 'author','comment','duration','end_time','entry_time','fixed','id','start_time',
+ 'author','comment','duration','end_time','entry_time','fixed','id','is_service','start_time',
'triggered_by','type'
],
'hostgroups' => [
@@ -134,22 +104,22 @@ my $expected_keys = {
],
'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',
+ 'active_checks_enabled','address','alias','check_command','check_command_expanded','check_flapping_recovery_notification','check_freshness','check_interval',
+ 'check_options','check_period','check_type','checks_enabled','childs','comments','comments_with_extra_info','comments_with_info',
+ 'contact_groups','contacts','current_attempt','current_notification_number','custom_variable_names',
+ 'custom_variable_values','custom_variables','display_name','downtimes','downtimes_with_info','event_handler','event_handler_enabled',
+ 'execution_time','filename','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',
+ 'next_notification','no_more_notifications','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',
+ 'pending_flex_downtime','percent_state_change','pnpgraph_present','perf_data','plugin_output',
+ 'process_performance_data','retry_interval','scheduled_downtime_depth','services','services_with_info','services_with_state',
'state','state_type','statusmap_image','total_services','worst_service_hard_state','worst_service_state',
'x_3d','y_3d','z_3d'
],
@@ -173,9 +143,9 @@ my $expected_keys = {
'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',
+ 'active_checks_enabled','check_command','check_command_expanded','check_freshness','check_interval','check_options','check_period',
+ 'check_type','checks_enabled','comments','comments_with_extra_info','comments_with_info','contact_groups','contacts','current_attempt',
+ 'current_notification_number','custom_variable_names','custom_variable_values','custom_variables',
'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',
@@ -183,21 +153,22 @@ my $expected_keys = {
'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',
+ 'next_check','next_notification','no_more_notifications','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',
+ 'percent_state_change','pnpgraph_present','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__'
],
+ 'statehist' => [],
'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',
+ 'execute_host_checks','execute_service_checks','external_command_buffer_max','external_command_buffer_slots','external_command_buffer_usage','external_commands','external_commands_rate','forks','forks_rate','host_checks','host_checks_rate','interval_length',
+ 'last_command_check','last_log_rotation','livecheck_overflows','livecheck_overflows_rate','livechecks','livechecks_rate','livestatus_active_connections','livestatus_queued_connections','livestatus_threads','livestatus_version','log_messages','log_messages_rate','nagios_pid','neb_callbacks',
+ 'neb_callbacks_rate','num_hosts','num_services','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' ],
@@ -243,13 +214,14 @@ for my $key (sort keys %{$objects_to_test}) {
#########################
# check keys
for my $type (keys %{$expected_keys}) {
+ next if $type eq 'statehist';
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 );
+ 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};
diff --git a/t/31-Monitoring-Livestatus-MULTI-live-test.t b/t/31-Monitoring-Livestatus-MULTI-live-test.t
deleted file mode 100644
index fb7fa94..0000000
--- a/t/31-Monitoring-Livestatus-MULTI-live-test.t
+++ /dev/null
@@ -1,95 +0,0 @@
-#!/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\")...");
-}
diff --git a/t/32-Monitoring-Livestatus-backend-test.t b/t/32-Monitoring-Livestatus-backend-test.t
index cce6e16..89c5caa 100644
--- a/t/32-Monitoring-Livestatus-backend-test.t
+++ b/t/32-Monitoring-Livestatus-backend-test.t
@@ -12,7 +12,7 @@ if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} or !defined $ENV{
plan( skip_all => $msg );
} else {
# we dont know yet how many tests we got
- plan( tests => 55237 );
+ plan( tests => 57070 );
}
# set an alarm
@@ -21,7 +21,7 @@ $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"
+ confess "timeout reached:".Dumper(\@caller)."\n"
};
use_ok('Monitoring::Livestatus');
@@ -33,9 +33,6 @@ my $objects_to_test = {
# 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}) {
@@ -54,6 +51,7 @@ for my $key (sort keys %{$objects_to_test}) {
#########################
# check keys
for my $type (@tables) {
+ next if $type eq 'statehist';
alarm(120);
my $filter = "";
$filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log';
@@ -98,7 +96,7 @@ for my $key (sort keys %{$objects_to_test}) {
}
# wait till backend is started up again
- if(!defined $hash_ref and $Monitoring::Livestatus::ErrorCode > 200) {
+ if(!defined $hash_ref and $Monitoring::Livestatus::ErrorCode > 200) {
sleep(2);
}
}
diff --git a/t/34-Monitoring-Livestatus-utf8_support.t b/t/34-Monitoring-Livestatus-utf8_support.t
index 47e31d5..c296bbc 100644
--- a/t/34-Monitoring-Livestatus-utf8_support.t
+++ b/t/34-Monitoring-Livestatus-utf8_support.t
@@ -7,8 +7,12 @@ 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';
+if ( !defined $ENV{TEST_UTF8} ) {
+ my $msg = 'Author test. $ENV{TEST_UTF8} to run';
+ plan( skip_all => $msg );
+}
+elsif ( !defined $ENV{TEST_SERVER} ) {
+ my $msg = 'Author test. Set $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 9 );
--
2.1.4
-------------- next part --------------
>From 99232587dc689e7d6fde4f640752523f4fd3fe04 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 12:19:43 +0100
Subject: Use metacpan.org instead of search.cpan.org.
---
debian/changelog | 1 +
debian/control | 2 +-
debian/copyright | 2 +-
debian/watch | 2 +-
4 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index 15c24b0..db58df7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ libmonitoring-livestatus-perl (0.74-2) UNRELEASED; urgency=medium
* Team upload.
* Restructure control file with cme.
* Update Vcs-Git URL to use HTTPS.
+ * Use metacpan.org instead of search.cpan.org.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:15:41 +0100
diff --git a/debian/control b/debian/control
index a197f21..5330d25 100644
--- a/debian/control
+++ b/debian/control
@@ -9,7 +9,7 @@ Build-Depends-Indep: libjson-xs-perl,
Standards-Version: 3.9.2
Vcs-Browser: https://anonscm.debian.org/cgit/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Vcs-Git: https://anonscm.debian.org/git/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
-Homepage: http://search.cpan.org/dist/Monitoring-Livestatus/
+Homepage: https://metacpan.org/release/Monitoring-Livestatus
Package: libmonitoring-livestatus-perl
Architecture: all
diff --git a/debian/copyright b/debian/copyright
index 1c62cda..759fa60 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,6 +1,6 @@
Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
Maintainer: Sven Nierlein, <nierlein at cpan.org>
-Source: http://search.cpan.org/dist/Monitoring-Livestatus/
+Source: https://metacpan.org/release/Monitoring-Livestatus
Name: Monitoring-Livestatus
Files: *
diff --git a/debian/watch b/debian/watch
index 2ef5a62..583273d 100644
--- a/debian/watch
+++ b/debian/watch
@@ -1,2 +1,2 @@
version=3
-http://search.cpan.org/dist/Monitoring-Livestatus/ .*/Monitoring-Livestatus-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
+https://metacpan.org/release/Monitoring-Livestatus .*/Monitoring-Livestatus-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
--
2.1.4
-------------- next part --------------
>From 1c2650820fb71965f13ab425d29383a84f1d1895 Mon Sep 17 00:00:00 2001
From: Bas Couwenberg <sebastic at xs4all.nl>
Date: Fri, 23 Dec 2016 13:55:25 +0100
Subject: Add build dependencies on procps & netcat for tests.
---
debian/changelog | 1 +
debian/control | 4 +++-
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/debian/changelog b/debian/changelog
index f8e0b93..a88725e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -10,6 +10,7 @@ libmonitoring-livestatus-perl (0.76-1) UNRELEASED; urgency=medium
* Enable parallel builds.
* Switch to source format 3.0 (quilt).
* Add patch to fix testfile existence test.
+ * Add build dependencies on procps & netcat for tests.
-- Bas Couwenberg <sebastic at debian.org> Fri, 23 Dec 2016 12:28:02 +0100
diff --git a/debian/control b/debian/control
index a0ff313..17d935b 100644
--- a/debian/control
+++ b/debian/control
@@ -5,7 +5,9 @@ Section: perl
Priority: optional
Build-Depends: debhelper (>= 9)
Build-Depends-Indep: libjson-xs-perl,
- perl
+ netcat,
+ perl,
+ procps
Standards-Version: 3.9.2
Vcs-Browser: https://anonscm.debian.org/cgit/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
Vcs-Git: https://anonscm.debian.org/git/pkg-nagios/pkg-libmonitoring-livestatus-perl.git
--
2.1.4
More information about the Pkg-nagios-devel
mailing list