--- /dev/null
+use strict;
+use warnings FATAL => 'all';
+use ExtUtils::MakeMaker;
+
+(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
+
+WriteMakefile(
+ NAME => 'System-Introspector-Report',
+ VERSION_FROM => 'lib/System/Introspector/Report.pm',
+ PREREQ_PM => {
+ 'Moo' => '1.000000',
+ 'HTML::Zoom' => '0.009006',
+ 'Config::General' => '2.51',
+ 'Module::Runtime' => '0.013',
+ 'IO::All' => '0.45',
+ 'strictures' => '1',
+ 'JSON::PP' => '2.53',
+ 'Object::Remote' => '0.001001',
+ 'MRO::Compat' => 0,
+ 'Class::C3' => 0,
+ 'Getopt::Long' => 0,
+ 'Pod::Usage' => 0,
+ 'aliased' => 0,
+ },
+ EXE_FILES => [
+ 'bin/system-introspector-report',
+ ],
+);
--- /dev/null
+#!/usr/bin/env perl
+use strictures;
+use Getopt::Long;
+use Pod::Usage;
+use System::Introspector::Report::Source;
+use System::Introspector::Report::Config;
+
+GetOptions(
+ 's|storage=s' => \my $storage_dir,
+ 'c|config=s' => \my $config_file,
+ 'r|report=s' => \my @report_types,
+ 'p|publish=s' => \my @publish_types,
+ 'a|all' => \my $all_reports,
+ 'h|help' => sub { pod2usage(0) },
+) or pod2usage(2);
+
+die "$0 requires --storage (-s) to be specified\n"
+ unless defined $storage_dir;
+
+die "$0 requires --config (-c) to be specified\n"
+ unless defined $storage_dir;
+
+my $config = System::Introspector::Report::Config
+ ->new(config_file => $config_file);
+
+my $source = System::Introspector::Report::Source
+ ->new_from_root($storage_dir);
+
+my @types = $all_reports
+ ? $config->report_types
+ : map [$_, {}], @report_types;
+my @reports = $source->generate(@types);
+
+for my $publisher ($config->publishers(@publish_types)) {
+ $publisher->publish(\@reports);
+}
+
+__END__
+
+=head1 NAME
+
+system-introspector-report - Generate System::Introspector reports
+
+=cut
--- /dev/null
+package System::Introspector::Report;
+
+our $VERSION = '0.000001'; # 0.0.1
+
+$VERSION = eval $VERSION;
+
+1;
+
+=head1 NAME
+
+System::Introspector::Report - Description goes here
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+ Robert Sedlacek <r.sedlacek@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+None yet - maybe this software is perfect! (ahahahahahahahahaha)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012 the System::Introspector::Report L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
--- /dev/null
+package System::Introspector::Report::Builder;
+use Moo;
+
+sub required_data { () }
+
+sub collect_from {
+ die sprintf "Instance '%s' does not provide 'collect_from'\n", shift;
+}
+
+sub render_reports {
+ die sprintf "Instance '%s' does not provide 'render_reports'\n", shift;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Builder::Packages::Apt::API;
+use Moo::Role;
+
+requires qw(
+ _collect_from_data
+);
+
+sub collect_from {
+ my ($self, $id, $data) = @_;
+ my $host = $data->{host}{hostname};
+ my $package = $data->{'packages/apt'}{installed}{packages} || {};
+ my $upgrade = $data->{'packages/apt'}{upgradable}{actions}{inst} || {};
+ return $self->_collect_from_data($id, $host, $package, $upgrade, $data);
+}
+
+sub _clear_upgrade {
+ my ($self, $string, $version) = @_;
+ return undef
+ unless defined $string;
+ $string =~ s{^\[\Q$version\E\]\s*\((.+)\)$}{$1};
+ return $string;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Builder::Packages::Apt::ByHost;
+use Moo;
+
+extends 'System::Introspector::Report::Builder';
+
+has _known_package => (is => 'ro', default => sub { {} });
+has _host_package => (is => 'ro', default => sub { {} });
+has _host_upgrade => (is => 'ro', default => sub { {} });
+
+sub required_data {
+ return qw(
+ packages/apt
+ host
+ );
+}
+
+sub _collect_from_data {
+ my ($self, $id, $hostname, $packages, $upgrade, $data) = @_;
+ for my $package (keys %$packages) {
+ $self->_known_package->{$package}++;
+ }
+ $self->_host_package->{$id} = $packages;
+ $self->_host_upgrade->{$id} = $upgrade;
+ return 1;
+}
+
+sub render_reports {
+ my ($self) = @_;
+ my @columns = (
+ { key => 'package', label => 'Package' },
+ { key => 'version', label => 'Version' },
+ { key => 'upgrade', label => 'Upgrade' },
+ );
+ my $host_package = $self->_host_package;
+ my $host_upgrade = $self->_host_upgrade;
+ my @known_packages = sort keys %{$self->_known_package};
+ return map {
+ my $remote = $_;
+ +{
+ columns => \@columns,
+ title => "Packages on $remote",
+ id => ['packages-apt-by-remote', $remote],
+ meta => { remote => $remote },
+ rows => [map {
+ my $package = $_;
+ my $version = $host_package->{$remote}{$package}{version};
+ my $upgrade = $self->_clear_upgrade(
+ $host_upgrade->{$remote}{$package},
+ $version,
+ );
+ +{
+ package => $package,
+ defined($version) ? (version => $version) : (),
+ defined($upgrade) ? (upgrade => $upgrade) : (),
+ };
+ } @known_packages],
+ };
+ } sort keys %{$self->_host_package};
+}
+
+with $_ for qw(
+ System::Introspector::Report::Builder::Packages::Apt::API
+);
+
+1;
--- /dev/null
+package System::Introspector::Report::Builder::Packages::Apt::ByPackage;
+use Moo;
+
+extends 'System::Introspector::Report::Builder';
+
+has _host_by_remote => (is => 'ro', default => sub { {} });
+has _host_data => (is => 'ro', default => sub { {} });
+
+sub required_data {
+ return qw(
+ packages/apt
+ host
+ );
+}
+
+sub _collect_from_data {
+ my ($self, $id, $hostname, $packages, $upgrades) = @_;
+ $self->_host_by_remote->{$id} = $hostname;
+ for my $package (keys %$packages) {
+ my $version = $packages->{$package}{version};
+ my $upgrade = $self->_clear_upgrade($upgrades->{$package}, $version);
+ $self->_host_data->{$package}{$id} = {
+ version => $version,
+ defined($upgrade) ? (upgrade => $upgrade) : (),
+ };
+ }
+}
+
+sub render_reports {
+ my ($self) = @_;
+ my @columns = (
+ { key => 'hostname', label => 'Hostname' },
+ { key => 'remote', label => 'Remote' },
+ { key => 'version', label => 'Version' },
+ { key => 'upgrade', label => 'Upgrade' },
+ );
+ my $data = $self->_host_data;
+ my $hbr = $self->_host_by_remote;
+ return map {
+ my $package = $_;
+ my $hosts = $data->{$package};
+ +{
+ columns => \@columns,
+ title => "$package Installations",
+ id => ['packages-apt-by-package', $package],
+ meta => { package => $package },
+ rows => [ map {
+ my $remote = $_;
+ +{
+ remote => $remote,
+ hostname => $hbr->{$remote},
+ %{$hosts->{$remote}},
+ };
+ } sort keys %$hosts ],
+ };
+ } sort keys %$data;
+}
+
+with $_ for qw(
+ System::Introspector::Report::Builder::Packages::Apt::API
+);
+
+1;
--- /dev/null
+package System::Introspector::Report::Builder::Perls;
+use Moo;
+
+extends 'System::Introspector::Report::Builder';
+
+has skip_errors => (is => 'ro', default => sub { 1 });
+
+has _rows => (is => 'ro', default => sub { [] });
+
+sub required_data {
+ return qw(
+ perls
+ host
+ );
+}
+
+sub collect_from {
+ my ($self, $id, $data) = @_;
+ my $perls = $data->{perls}{perls} || {};
+ my $hostname = $data->{host}{hostname};
+ if (my @perl_keys = sort keys %$perls) {
+ for my $perl_key (@perl_keys) {
+ my $perl = $perls->{$perl_key};
+ next if defined($perl->{__error__}) and $self->skip_errors;
+ push @{$self->_rows}, {
+ hostname => $hostname,
+ remote => $id,
+ location => $perl->{executable},
+ version => $perl->{config}{version},
+ defined($perl->{__error__})
+ ? (__error__ => $perl->{__error__})
+ : (),
+ };
+ }
+ }
+ else {
+ push @{$self->_rows}, {
+ hostname => $hostname,
+ remote => $id,
+ };
+ }
+ return 1;
+}
+
+sub render_reports {
+ my ($self) = @_;
+ return +{
+ title => 'Perl Installations',
+ id => 'perls',
+ columns => [
+ { key => 'remote', label => 'Remote' },
+ { key => 'hostname', label => 'Hostname' },
+ { key => 'location', label => 'Location' },
+ { key => 'version', label => 'Version' },
+ ],
+ rows => $self->_rows,
+ };
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Config;
+use Moo;
+use Config::General;
+use Module::Runtime qw( use_module );
+
+has config_file => (is => 'ro', required => 1);
+has config => (is => 'lazy');
+
+sub _build_config {
+ my ($self) = @_;
+ return +{
+ Config::General->new($self->config_file)->getall,
+ };
+}
+
+sub report_types {
+ my ($self) = @_;
+ my $reports = $self->config->{report} || {};
+ return map {
+ [$_, $reports->{$_}];
+ } sort keys %$reports;
+}
+
+sub publishers {
+ my ($self, @override) = @_;
+ my $publish = $self->config->{publish} || {};
+ return map {
+ use_module("System::Introspector::Report::Publish::$_")
+ ->new($publish->{$_} || {});
+ } @override ? @override : sort keys %$publish;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::API;
+use Moo::Role;
+
+requires qw(
+ publish
+);
+
+sub _prepare_matcher_from {
+ my ($self, $matchers) = @_;
+ my $pattern = join '|', map {
+ my @elements = split m{:}, $_;
+ join qr{\0}, map {
+ ($_ eq '*') ? qr{[^\0]+} : qr{\Q$_\E};
+ } split m{:}, $_;
+ } ref($matchers) ? @$matchers : $matchers;
+ return qr{^(?:$pattern)$};
+}
+
+sub _match_id {
+ my ($self, $report, $match) = @_;
+ $match = $self->_prepare_matcher_from($match)
+ unless ref($match) eq 'Regexp';
+ my $id = join "\0", ref($report->{id})
+ ? @{$report->{id}}
+ : ($report->{id});
+ return $id =~ $match;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::MediaWiki;
+use Moo;
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Producer';
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Connection';
+
+has page_options => (
+ is => 'ro',
+ default => sub { {} },
+ init_arg => 'page',
+);
+
+has producer => (is => 'lazy', handles => {
+ _render_page => 'render',
+});
+
+has connection => (is => 'ro', lazy => 1, builder => 1, handles => {
+ get_page => 'get',
+ put_page => 'put',
+});
+
+sub _build_producer { Producer->new }
+sub _build_connection { Connection->new }
+
+sub publish {
+ my ($self, $reports) = @_;
+ my $pages = $self->page_options;
+ for my $page (sort keys %$pages) {
+ $self->_publish_page($reports, $page, $pages->{$page});
+ }
+ return 1;
+}
+
+sub _sort_reports {
+ my ($self, $reports, $included) = @_;
+ my @matchers = map {
+ $self->_prepare_matcher_from($_);
+ } ref($included) ? @{$included} : $included;
+ my @grouped;
+ for my $report (@$reports) {
+ my ($group_idx) = grep {
+ $self->_match_id($report, $matchers[$_]);
+ } 0 .. $#matchers;
+ if (defined $group_idx) {
+ push @{$grouped[$group_idx]}, $report;
+ }
+ }
+ return [ map { (@$_) } @grouped ];
+}
+
+sub _publish_page {
+ my ($self, $reports, $page, $options) = @_;
+ my $sorted = $self->_sort_reports($reports, $options->{report} || []);
+ print $self->_render_page($sorted);
+# print $self->render_report($_)
+# for @$sorted;
+ return 1;
+}
+
+with $_ for qw(
+ System::Introspector::Report::Publish::API
+);
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::MediaWiki::Connection;
+use Moo;
+
+sub get { }
+
+sub put { }
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::MediaWiki::Page;
+use Moo;
+
+has timestamp => (is => 'ro', required => 1);
+has content => (is => 'ro', required => 1);
+
+sub update {
+ my ($self, $update_stream) = @_;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::MediaWiki::Parser;
+use Moo;
+use HTML::Zoom;
+
+my $_rx_front = qr{\A<!--\s+SI:};
+my $_rx_end = qr{\s+-->\Z};
+my $_rx_table_begin = qr{ $_rx_front TABLE \s+ begin \s+ }x;
+my $_rx_table_end = qr{ $_rx_front TABLE \s+ end \s+ }x;
+my $_rx_title_begin = qr{ $_rx_front TITLE \s+ begin \s+ }x;
+my $_rx_title_end = qr{ $_rx_front TITLE \s+ end \s+ }x;
+my $_rx_any_begin = qr{ $_rx_front (TABLE|TITLE) \s+ begin \s }x;
+my $_rx_id = qr{(\S+)};
+
+sub parse {
+ my ($self, $body) = @_;
+ my $lines = [split m{\n}, $body];
+ my $parts = [];
+ my $state = '_parse_text';
+ while (@$lines) {
+ $state = $self->$state($lines, $parts);
+ }
+ return $parts;
+}
+
+sub _parse_table {
+ my ($self, $lines, $done) = @_;
+ my ($id, $title) = $self->_read_title($lines);
+ my $description = [];
+ $self->_parse_text($lines, $description);
+ my $report = $self->_read_report($lines, $id);
+ $report->{title} = $title;
+ $report->{description} = $description;
+ push @$done, $report;
+ return '_parse_text';
+}
+
+sub _read_report {
+ my ($self, $lines, $id) = @_;
+ shift(@$lines) =~ m{ $_rx_table_begin \Q$id\E $_rx_end }x
+ or die "Expected table for '$id' after title\n";
+ my @report_lines;
+ while (@$lines) {
+ my $line = shift @$lines;
+ if ($line =~ m{ $_rx_table_end $_rx_id $_rx_end }x) {
+ return $self->_inflate_report(join('', @report_lines), $id);
+ }
+ push @report_lines, $line;
+ }
+ die "Missing end of '$id' report\n";
+}
+
+my $_is_type = sub {
+ my ($markup, $type, $tag) = @_;
+ my $next = $markup->peek;
+ return $markup->next
+ if not($next) or (
+ ($next->{name} || '') eq $tag
+ and ($next->{type} || '') eq uc($type)
+ );
+ return undef;
+};
+
+my $_collect_content = sub {
+ my ($stream, $type) = @_;
+ my @events;
+ until ($stream->$_is_type(close => $type)) {
+ push @events, $stream->next;
+ }
+ return HTML::Zoom->from_events(\@events)->to_html;
+};
+
+my $_get_class = sub {
+ my ($event, $rx) = @_;
+ my $class = $event->{attrs}{class} || '';
+ if ($class =~ $rx) {
+ return $1;
+ }
+ return undef;
+};
+
+sub _inflate_columns {
+ my ($self, $stream) = @_;
+ my $user_col_idx = 0;
+ my @columns;
+ while (my $next = $stream->next) {
+ if (my $ev = $stream->$_is_type(open => 'th')) {
+ my $key = $ev->$_get_class(qr{si-colhead-(\S+)});
+ my $label = $stream->$_collect_content('th');
+ push @columns, {
+ key => defined($key) ? $key : '__usercol_' . $user_col_idx++,
+ label => $label,
+ defined($key) ? () : (user => 1),
+ };
+ }
+ elsif ($stream->$_is_type(close => 'tr')) {
+ last;
+ }
+ }
+ return @columns;
+}
+
+sub _inflate_rows {
+ my ($self, $stream, $cols) = @_;
+ my @rows;
+ my $user_col_orph_idx = 0;
+ while (my $next = $stream->next) {
+ if ($stream->$_is_type(open => 'tr')) {
+ push @rows, {};
+ next;
+ }
+ if (my $ev = $stream->$_is_type(open => 'td')) {
+ my $key;
+ if ($#$cols >= scalar keys %{$rows[-1]}) {
+ $key = $cols->[scalar keys %{$rows[-1]}]{key};
+ }
+ else {
+ my $newcol = {
+ key => "__usercol_orph_" . $user_col_orph_idx++,
+ user => 1,
+ };
+ push @$cols, $newcol;
+ $key = $newcol->{key};
+ }
+ my $value = $stream->$_collect_content('td');
+ $rows[-1]{$key} = $value;
+ }
+ }
+ return \@rows;
+}
+
+sub _inflate_report {
+ my ($self, $table, $id) = @_;
+ my $markup = HTML::Zoom->from_html($table);
+ my $stream = $markup->to_stream;
+ my @columns = $self->_inflate_columns($stream);
+ my $rows = $self->_inflate_rows($stream, \@columns);
+ return {
+ id => [split m{:}, $id],
+ columns => [@columns],
+ rows => $rows,
+ };
+}
+
+sub _read_title {
+ my ($self, $lines) = @_;
+ my $start_line = shift @$lines;
+ $start_line =~ m{ $_rx_title_begin ($_rx_id) $_rx_end }x
+ or die "Unable to parse table start: $start_line\n";
+ my $id = $1;
+ my $title_line = shift @$lines;
+ $title_line =~ m{ \A == \s+ (.+) \s+ == \Z }x
+ or die "Unable to parse title line: $title_line\n";
+ my $title = $1;
+ my $end_line = shift(@$lines);
+ $end_line =~ m{ $_rx_title_end \Q$id\E $_rx_end }x
+ or die "Missing title end marker, found: $end_line\n";
+ return $id, $title;
+}
+
+sub _parse_text {
+ my ($self, $lines, $done) = @_;
+ while (@$lines) {
+ if ($lines->[0] =~ m{ $_rx_any_begin $_rx_id $_rx_end }x) {
+ return '_parse_table';
+ }
+ my $line = shift @$lines;
+ chomp $line;
+ push @$done, $line;
+ }
+ return undef;
+}
+
+1;
--- /dev/null
+package System::Introspector::Report::Publish::MediaWiki::Producer;
+use Moo;
+use HTML::Zoom;
+
+sub render {
+ my ($self, $stream) = @_;
+ return join "\n", map {
+ ref($_) ? $self->_render_table($_) : $_;
+ } @$stream;
+}
+
+sub _wrap {
+ my ($self, $type, $id, $body) = @_;
+ chomp $body;
+ return join "\n",
+ sprintf('<!-- SI:%s begin %s -->', uc($type), $id),
+ $body,
+ sprintf('<!-- SI:%s end %s -->', uc($type), $id),
+}
+
+sub _render_table {
+ my ($self, $report) = @_;
+ my $id = $report->{id};
+ my $str_id = ref($id) ? join(':', @$id) : $id;
+ my $markup = $self->_load_markup;
+ $markup = $self->_apply_identity($markup, $report);
+ $markup = $self->_apply_table_head($markup, $report);
+ $markup = $self->_apply_table_body($markup, $report);
+ my $description = $report->{description} || [''];
+ return join "\n",
+ $self->_wrap('title', $str_id, $self->_render_title($report)),
+ @$description,
+ $self->_wrap('table', $str_id, $markup->to_html),
+ '';
+}
+
+sub _render_title {
+ my ($self, $report) = @_;
+ return sprintf '== %s ==', $report->{title};
+}
+
+sub _apply_identity {
+ my ($self, $markup, $report) = @_;
+ my $id = $report->{id};
+ return $markup
+ ->select('table')
+ ->set_attribute(id => 'si-id-' . join '__',
+ ref($id) ? @$id : $id,
+ );
+}
+
+sub _apply_table_body {
+ my ($self, $markup, $report) = @_;
+ my $index = 0;
+ my $rows = $report->{rows};
+ my @cols = map $_->{key}, @{$report->{columns}};
+ return $markup->repeat('.data-row', sub {
+ return HTML::Zoom::CodeStream->new({
+ code => sub {
+ return if $index > $#$rows;
+ my $row = $rows->[$index++];
+ return sub {
+ $_->repeat('td', [ map {
+ my $col_idx = $_;
+ my $col = $cols[$_];
+ my $value = $row->{$col};
+ sub {
+ $_->apply_if($col !~ m{^__}, sub {
+ $_->add_to_attribute('td', class => "si-column-$col");
+ })
+ ->replace_content('td', defined($value) ? $value : '')
+ ->apply_if($col_idx != $#cols, sub {
+ $_->add_after('td', "\n ");
+ });
+ };
+ } 0 .. $#cols ]);
+ };
+ },
+ });
+ });
+}
+
+sub _apply_table_head {
+ my ($self, $markup, $report) = @_;
+ my @cols = @{$report->{columns}};
+ return $markup
+ ->repeat('th', [map {
+ my $col_idx = $_;
+ my $col = $cols[$_];
+ sub {
+ $_->apply_if($col->{key} !~ m{^__}, sub {
+ $_->add_to_attribute('th', class => 'si-colhead-' . $col->{key});
+ })
+ ->replace_content('th', $col->{label})
+ ->apply_if($col_idx != $#cols, sub {
+ $_->add_after('th', "\n ");
+ });
+ };
+ } 0 .. $#cols ])
+}
+
+sub _load_markup {
+ return HTML::Zoom->from_html(do {
+ local $/;
+ scalar <DATA>;
+ });
+}
+
+1;
+
+__DATA__
+<table class="si-report">
+ <tr>
+ <th>Header</th>
+ </tr>
+ <tr class="data-row">
+ <td>Value</td>
+ </tr>
+</table>
--- /dev/null
+package System::Introspector::Report::Publish::StdOut;
+use Moo;
+use JSON::PP;
+
+has report => (is => 'ro');
+
+my $_json = JSON::PP->new->utf8->pretty;
+
+sub publish {
+ my ($self, $reports) = @_;
+ my $match = $self->report;
+ return unless defined $match;
+ $match = $self->_prepare_matcher_from($match);
+ for my $idx (0 .. $#$reports) {
+ my $report = $reports->[$idx];
+ next unless $self->_match_id($report, $match);
+ print $_json->encode($report), "\n";
+ print "---\n"
+ if $idx < $#$reports;
+ }
+ return 1;
+}
+
+with $_ for qw(
+ System::Introspector::Report::Publish::API
+);
+
+1;
--- /dev/null
+package System::Introspector::Report::Source;
+use Moo;
+use JSON::PP;
+use IO::All;
+use Module::Runtime qw( use_module );
+
+my $_json = JSON::PP->new->utf8->relaxed->allow_nonref;
+
+has root => (is => 'ro', required => 1);
+
+sub new_from_root {
+ my ($class, $root, @args) = @_;
+ if ($root =~ m{^(.+):(.+)$}) {
+ my ($remote, $remote_root) = ($1, $2);
+ require Object::Remote;
+ return $class->new::on($remote, @args, root => $remote_root);
+ }
+ else {
+ return $class->new(@args, root => $root);
+ }
+}
+
+sub generate {
+ my ($self, @types) = @_;
+ my @generators = map { $self->_make_generator($_) } @types;
+ my $required = +{ map { ($_ => 1) } map $_->required_data, @generators };
+ my @dirs = $self->_find_source_dirs;
+ for my $dir_spec (@dirs) {
+ my ($id, $path) = @$dir_spec;
+ my $data = $self->_load_dataset($path, $required)
+ or next;
+ $_->collect_from($id, $data)
+ for @generators;
+ }
+ return map { ($_->render_reports) } @generators;
+}
+
+sub _load_dataset {
+ my ($self, $path, $required) = @_;
+ my $root = $self->root;
+ return +{
+ map {
+ ($_->[0], $_json->decode(scalar $_->[1]->slurp) || {});
+ } grep {
+ $required->{$_->[0]};
+ } map {
+ my $key = $_;
+ $key =~ s!^\Q$root\E/*(?:[^/]+/+){2}!!;
+ $key =~ s{\.json$}{};
+ [$key, $_];
+ } grep {
+ not(m{^\.}) and m{\.json$};
+ } $path->deep->all_files
+ };
+}
+
+sub _find_source_dirs {
+ my ($self) = @_;
+ my $root = $self->root;
+ return map {
+ (my $id = $_) =~ s{^\Q$root\E/*}{};
+ [$id, $_];
+ } io($root)->all_dirs;
+}
+
+sub _make_generator {
+ my ($self, $spec) = @_;
+ my ($type, $args) = @$spec;
+ return use_module("System::Introspector::Report::Builder::$type")
+ ->new($args || {});
+}
+
+1;
--- /dev/null
+BEGIN {
+ -e 'Distar'
+ or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git")
+}
+use lib 'Distar/lib';
+use Distar;
+
+author 'Robert Sedlacek <r.sedlacek@shadowcat.co.uk>';
--- /dev/null
+use strictures 1;
+use Test::More;
+
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Parser';
+
+my $parser = Parser->new;
+my $stream = $parser->parse(<<'EOR');
+
+= Heading =
+
+<!-- SI:TITLE begin foo -->
+== Foo ==
+<!-- SI:TITLE end foo -->
+
+User description
+
+<!-- SI:TABLE begin foo -->
+<table class="si-report">
+ <tr>
+ <th class="si-colhead-bar">Bar</th>
+ <th class="si-colhead-baz">Baz</th>
+ <th>
+ Qux
+ </th>
+ </tr>
+ <tr>
+ <td class="si-column-bar">231</td>
+ <td class="si-column-baz">421</td>
+ <td>171</td>
+ </tr>
+ <tr>
+ <td class="si-column-bar">232</td>
+ <td class="si-column-baz">422</td>
+ <td>172</td>
+ <td>173</td>
+ </tr>
+</table>
+<!-- SI:TABLE end foo -->
+
+End Text
+
+EOR
+
+is shift(@$stream), '', 'empty line';
+is shift(@$stream), '= Heading =', 'heading';
+is shift(@$stream), '', 'empty line';
+
+do {
+ my $report = shift @$stream;
+ is ref($report), 'HASH', 'report structure';
+
+ is_deeply $report->{id}, ['foo'], 'report id';
+ is $report->{title}, 'Foo', 'report title';
+
+ is $report->{columns}[0]{key}, 'bar', 'first column key';
+ is $report->{columns}[0]{label}, 'Bar', 'first column label';
+ ok not($report->{columns}[0]{user}), 'first column not user supplied';
+
+ is $report->{columns}[1]{key}, 'baz', 'second column key';
+ is $report->{columns}[1]{label}, 'Baz', 'second column label';
+ ok not($report->{columns}[1]{user}), 'second column not user supplied';
+
+ is $report->{columns}[2]{key}, '__usercol_0', 'first user supplied column key';
+ like $report->{columns}[2]{label}, qr{^\s+Qux\s+$}, 'first user supplied column label';
+ ok $report->{columns}[2]{user}, 'third column is user supplied';
+
+ is $report->{columns}[3]{key}, '__usercol_orph_0', 'second user supplied column key';
+ is $report->{columns}[3]{label}, undef, 'second user supplied column label is empty';
+ ok $report->{columns}[3]{user}, 'fourth column is user supplied';
+
+ is_deeply $report->{rows}[0], {
+ bar => 231, baz => 421, __usercol_0 => 171,
+ }, 'first row';
+ is_deeply $report->{rows}[1], {
+ bar => 232, baz => 422, __usercol_0 => 172, __usercol_orph_0 => 173,
+ }, 'second row';
+};
+
+is shift(@$stream), '', 'empty line';
+is shift(@$stream), 'End Text', 'end text';
+is shift(@$stream), '', 'empty line'
+ while @$stream;
+
+done_testing;
projects / scpubgit/System-Introspector-Report.git / commitdiff