'strictures' => '1',
'JSON::PP' => '2.53',
'Object::Remote' => '0.001001',
+ 'MediaWiki::API' => '0.39',
'MRO::Compat' => 0,
'Class::C3' => 0,
'Getopt::Long' => 0,
'Pod::Usage' => 0,
'aliased' => 0,
+ 'Try::Tiny' => 0,
},
EXE_FILES => [
'bin/system-introspector-report',
use strictures;
use Getopt::Long;
use Pod::Usage;
+use Try::Tiny;
use System::Introspector::Report::Source;
use System::Introspector::Report::Config;
my @reports = $source->generate(@types);
for my $publisher ($config->publishers(@publish_types)) {
- $publisher->publish(\@reports);
+ try {
+ $publisher->publish(\@reports);
+ }
+ catch {
+ print "Error during publish: $_\n";
+ };
}
__END__
title => 'Perl Installations',
id => 'perls',
rowid => [qw( remote location )],
+ meta => {},
columns => [
{ key => 'remote', label => 'Remote' },
{ key => 'hostname', label => 'Hostname' },
package System::Introspector::Report::Publish::MediaWiki;
use Moo;
+use Try::Tiny;
use aliased 'System::Introspector::Report::Publish::MediaWiki::Connection';
has page_options => (
put_page => 'put',
});
-sub _build_producer { Producer->new }
-sub _build_connection { Connection->new }
+has api_uri => (is => 'ro', required => 1);
+has username => (is => 'ro', required => 1);
+has password => (is => 'ro', required => 1);
+has create => (is => 'ro', default => sub { 0 });
+has http_auth => (is => 'ro');
+has http_realm => (is => 'ro');
+
+sub _build_producer { Producer->new }
+
+sub _build_connection {
+ my ($self) = @_;
+ return Connection->new(
+ api_uri => $self->api_uri,
+ username => $self->username,
+ password => $self->password,
+ create => $self->create,
+ $self->http_auth ? (
+ http_auth => 1,
+ http_realm => $self->http_realm,
+ ) : (),
+ );
+}
sub publish {
my ($self, $reports) = @_;
my $pages = $self->page_options;
+ printf "Pushing reports to MediaWiki at '%s'\n", $self->api_uri;
for my $page (sort keys %$pages) {
+ print "Updating page '$page'\n";
$self->_publish_page($reports, $page, $pages->{$page});
}
return 1;
sub _publish_page {
my ($self, $reports, $page_name, $options) = @_;
my $sorted = $self->_sort_reports($reports, $options->{report} || []);
- my $page = $self->get_page($page_name);
- $page->update($sorted);
- $self->put_page($page);
+ try {
+ my $page = $self->get_page($page_name);
+ $page->update($sorted);
+ $self->put_page($page);
+ }
+ catch {
+ print "Error during page update: $_\n";
+ };
return 1;
}
package System::Introspector::Report::Publish::MediaWiki::Connection;
use Moo;
+use MediaWiki::API;
+use URI;
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Page';
+
+has api => (is => 'lazy');
+has api_uri => (is => 'ro', required => 1);
+has username => (is => 'ro', required => 1);
+has password => (is => 'ro', required => 1);
+has create => (is => 'ro', default => sub { 0 });
+has http_auth => (is => 'ro');
+has http_realm => (is => 'ro');
+
+my $_api_fail = sub {
+ my $api = shift;
+ die sprintf "MediaWiki Error %s: %s\n",
+ $api->{error}{code},
+ $api->{error}{details};
+};
+
+sub _build_api {
+ my ($self) = @_;
+ my $api_uri = URI->new($self->api_uri);
+ my $api = MediaWiki::API->new({ api_url => $self->api_uri });
+ my $passwd = $self->password;
+ if ($ENV{TEST_SI_MEDIAWIKI_GETPWD}) {
+ system "stty -echo";
+ printf "MediaWiki password for '%s': ", $self->username;
+ $passwd = <STDIN>;
+ chomp $passwd;
+ system "stty echo";
+ print "\n";
+ }
+ $api->{ua}->credentials(
+ join(':', $api_uri->host, $api_uri->port),
+ $self->http_realm || 'Wiki',
+ $self->username,
+ $passwd,
+ ) if $self->http_auth;
+ $api->login({
+ lgname => $self->username,
+ lgpassword => $passwd,
+ }) or $api->$_api_fail;
+ return $api;
+}
sub get {
my ($self, $page_name) = @_;
+ my $page = $self->api->get_page({ title => $page_name })
+ or $self->api->$_api_fail;
+ if (defined $page->{missing}) {
+ die "MediaWiki page '$page_name' does not exist\n"
+ unless $self->create;
+ return Page->new(
+ name => $page_name,
+ content => '',
+ );
+ }
+ return Page->new(
+ name => $page_name,
+ timestamp => $page->{timestamp},
+ content => $page->{'*'} || '',
+ );
}
sub put {
my ($self, $page) = @_;
+ $self->api->edit({
+ action => 'edit',
+ title => $page->name,
+ text => $page->content,
+ $page->has_timestamp
+ ? (basetimestamp => $page->timestamp)
+ : (),
+ }) or $self->api->$_api_fail;
+ return 1;
}
1;
use aliased 'System::Introspector::Report::Updater';
has name => (is => 'ro', required => 1);
-has timestamp => (is => 'ro', required => 1);
+has timestamp => (is => 'ro', predicate => 'has_timestamp');
has content => (is => 'rwp', required => 1);
my $_producer = Producer->new;
--- /dev/null
+use strictures 1;
+use Test::More;
+use FindBin;
+use aliased 'System::Introspector::Report::Source';
+
+my $source = Source->new(root => "$FindBin::Bin/data/json/");
+my @reports = $source->generate(['Packages::Apt::ByHost', {}]);
+
+is scalar(@reports), 2, 'two reports received';
+
+my $_test_columns = sub {
+ my ($rep, @columns) = @_;
+ my %cols = map { ($_->{key}, 1) } @{$rep->{columns}};
+ ok $cols{$_}, "$_ column exists"
+ for @columns;
+};
+
+my $_test_rows = sub {
+ my ($rep, @rows) = @_;
+ is scalar(@{$rep->{rows}}), scalar(@rows), 'matching number of rows';
+ for my $idx (0 .. $#rows) {
+ is $rep->{rows}[$idx]{$_}, $rows[$idx]{$_}, "row $idx $_ value"
+ for sort keys %{$rows[$idx]};
+ }
+};
+
+subtest "first report" => sub {
+ my $rep = $reports[0];
+ is_deeply $rep->{id}, ['packages-apt-by-remote', 'hostA'], 'report id';
+ like $rep->{title}, qr{hostA}, 'report title contains remote';
+ is_deeply $rep->{meta}, { remote => 'hostA' }, 'meta data';
+ is_deeply $rep->{rowid}, ['package'], 'correct rowid';
+ $rep->$_test_columns(qw( package version upgrade ));
+ $rep->$_test_rows(
+ { package => 'bar', version => 17, upgrade => '18' },
+ { package => 'baz', version => undef, upgrade => undef, },
+ { package => 'foo', version => 23, upgrade => undef },
+ { package => 'qux', version => 77, upgrade => '80' },
+ );
+};
+
+subtest "second report" => sub {
+ my $rep = $reports[1];
+ is_deeply $rep->{id}, ['packages-apt-by-remote', 'hostB'], 'report id';
+ like $rep->{title}, qr{hostB}, 'report title contains remote';
+ is_deeply $rep->{meta}, { remote => 'hostB' }, 'meta data';
+ is_deeply $rep->{rowid}, ['package'], 'correct rowid';
+ $rep->$_test_columns(qw( package version upgrade ));
+ $rep->$_test_rows(
+ { package => 'bar', version => 18, upgrade => undef },
+ { package => 'baz', version => 99, upgrade => undef, },
+ { package => 'foo', version => 23, upgrade => 'unparsable' },
+ { package => 'qux', version => undef, upgrade => undef },
+ );
+};
+
+done_testing;
--- /dev/null
+use strictures 1;
+use Test::More;
+use FindBin;
+use aliased 'System::Introspector::Report::Source';
+
+my $source = Source->new(root => "$FindBin::Bin/data/json/");
+my @reports = $source->generate(['Packages::Apt::ByPackage', {}]);
+
+is scalar(@reports), 4, 'four reports received';
+
+my $_test_columns = sub {
+ my ($rep, @columns) = @_;
+ my %cols = map { ($_->{key}, 1) } @{$rep->{columns}};
+ ok $cols{$_}, "$_ column exists"
+ for @columns;
+};
+
+my $_test_rows = sub {
+ my ($rep, @rows) = @_;
+ is scalar(@{$rep->{rows}}), scalar(@rows), 'matching number of rows';
+ for my $idx (0 .. $#rows) {
+ is $rep->{rows}[$idx]{$_}, $rows[$idx]{$_}, "row $idx $_ value"
+ for sort keys %{$rows[$idx]};
+ }
+};
+
+subtest "first report" => sub {
+ my $rep = shift @reports;
+ is_deeply $rep->{id}, ['packages-apt-by-package', 'bar'], 'report id';
+ like $rep->{title}, qr{bar}, 'report title contains package';
+ is_deeply $rep->{meta}, { package => 'bar' }, 'meta data';
+ is_deeply $rep->{rowid}, ['remote'], 'correct rowid';
+ $rep->$_test_columns(qw( hostname remote version upgrade ));
+ $rep->$_test_rows(
+ { remote => 'hostA',
+ hostname => 'a.example.com',
+ version => 17,
+ upgrade => 18,
+ },
+ { remote => 'hostB',
+ hostname => 'b.example.com',
+ version => 18,
+ upgrade => undef,
+ },
+ );
+};
+
+subtest "second report" => sub {
+ my $rep = shift @reports;
+ is_deeply $rep->{id}, ['packages-apt-by-package', 'baz'], 'report id';
+ like $rep->{title}, qr{baz}, 'report title contains package';
+ is_deeply $rep->{meta}, { package => 'baz' }, 'meta data';
+ is_deeply $rep->{rowid}, ['remote'], 'correct rowid';
+ $rep->$_test_columns(qw( hostname remote version upgrade ));
+ $rep->$_test_rows(
+ { remote => 'hostB',
+ hostname => 'b.example.com',
+ version => 99,
+ upgrade => undef,
+ },
+ );
+};
+
+subtest "third report" => sub {
+ my $rep = shift @reports;
+ is_deeply $rep->{id}, ['packages-apt-by-package', 'foo'], 'report id';
+ like $rep->{title}, qr{foo}, 'report title contains package';
+ is_deeply $rep->{meta}, { package => 'foo' }, 'meta data';
+ is_deeply $rep->{rowid}, ['remote'], 'correct rowid';
+ $rep->$_test_columns(qw( hostname remote version upgrade ));
+ $rep->$_test_rows(
+ { remote => 'hostA',
+ hostname => 'a.example.com',
+ version => 23,
+ upgrade => undef,
+ },
+ { remote => 'hostB',
+ hostname => 'b.example.com',
+ version => 23,
+ upgrade => 'unparsable',
+ },
+ );
+};
+
+subtest "fourth report" => sub {
+ my $rep = shift @reports;
+ is_deeply $rep->{id}, ['packages-apt-by-package', 'qux'], 'report id';
+ like $rep->{title}, qr{qux}, 'report title contains package';
+ is_deeply $rep->{meta}, { package => 'qux' }, 'meta data';
+ is_deeply $rep->{rowid}, ['remote'], 'correct rowid';
+ $rep->$_test_columns(qw( hostname remote version upgrade ));
+ $rep->$_test_rows(
+ { remote => 'hostA',
+ hostname => 'a.example.com',
+ version => 77,
+ upgrade => 80,
+ },
+ );
+};
+
+done_testing;
--- /dev/null
+use strictures 1;
+use Test::More;
+use FindBin;
+use aliased 'System::Introspector::Report::Source';
+
+my $source = Source->new(root => "$FindBin::Bin/data/json/");
+my @reports = $source->generate(['Perls', {}]);
+
+is scalar(@reports), 1, 'single report generated';
+my $rep = $reports[0];
+
+is $rep->{id}, 'perls', 'report id';
+like $rep->{title}, qr{perl}i, 'report title contains perl';
+is_deeply $rep->{meta}, {}, 'no metadata in this report';
+is_deeply $rep->{rowid}, [qw( remote location )], 'correct rowid';
+my %cols = map { ($_->{key}, 1) } @{$rep->{columns}};
+ok $cols{$_}, "$_ column exists"
+ for qw( remote hostname location version );
+my @rows = (
+ { hostname => 'a.example.com',
+ remote => 'hostA',
+ location => '/foo/bar/perl',
+ version => '5.10.0',
+ },
+ { hostname => 'a.example.com',
+ remote => 'hostA',
+ location => '/foo/baz/perl',
+ version => '5.14.1',
+ },
+ { hostname => 'b.example.com',
+ remote => 'hostB',
+ location => '/foo/bar/perl',
+ version => '5.10.0',
+ },
+ { hostname => 'b.example.com',
+ remote => 'hostB',
+ location => '/foo/qux/perl',
+ version => '5.14.1',
+ },
+);
+for my $idx (0 .. $#rows) {
+ is $rep->{rows}[$idx]{$_}, $rows[$idx]{$_}, "row $idx $_ value"
+ for sort keys %{$rows[$idx]};
+}
+
+done_testing;
--- /dev/null
+{ "hostname": "a.example.com" }
--- /dev/null
+{
+ "installed": {
+ "packages": {
+ "foo": {
+ "version": 23,
+ },
+ "bar": {
+ "version": 17,
+ },
+ "qux": {
+ "version": 77,
+ },
+ },
+ },
+ "upgradable": {
+ "actions": {
+ "inst": {
+ "bar": "[17] (18)",
+ "qux": "[77] (80)",
+ },
+ },
+ },
+}
--- /dev/null
+{ "perls": {
+ "/foo/bar": {
+ "config": {
+ "version": "5.10.0",
+ },
+ "executable": "/foo/bar/perl",
+ },
+ "/foo/baz": {
+ "config": {
+ "version": "5.14.1",
+ },
+ "executable": "/foo/baz/perl",
+ },
+} }
--- /dev/null
+{ "hostname": "b.example.com" }
--- /dev/null
+{
+ "installed": {
+ "packages": {
+ "foo": {
+ "version": 23,
+ },
+ "bar": {
+ "version": 18,
+ },
+ "baz": {
+ "version": 99,
+ },
+ },
+ },
+ "upgradable": {
+ "actions": {
+ "inst": {
+ "foo": "unparsable",
+ },
+ },
+ },
+}
+
--- /dev/null
+{ "perls": {
+ "/foo/bar": {
+ "config": {
+ "version": "5.10.0",
+ },
+ "executable": "/foo/bar/perl",
+ },
+ "/foo/qux": {
+ "config": {
+ "version": "5.14.1",
+ },
+ "executable": "/foo/qux/perl",
+ },
+} }
--- /dev/null
+use strictures 1;
+use Test::More;
+
+use aliased 'System::Introspector::Report::Updater';
+
+my $updater = Updater->new;
+
+my $content = $updater->merge(
+ [],
+ [
+ { id => "foo",
+ title => "Foo",
+ columns => [{ key => "a", label => "A" }, { key => "b", label => "B" }],
+ rows => [
+ { a => 17, b => 23 },
+ { a => 23, b => 17 },
+ ],
+ },
+ { id => "bar",
+ title => "Bar",
+ columns => [{ key => "a", label => "A" }, { key => "b", label => "B" }],
+ rows => [
+ { a => 17, b => 23 },
+ { a => 23, b => 17 },
+ ],
+ },
+ ],
+);
+
+ok scalar(@$content), 'received content';
+
+done_testing;
projects / scpubgit/System-Introspector-Report.git / commitdiff