columns => \@columns,
title => "Packages on $remote",
id => ['packages-apt-by-remote', $remote],
+ rowid => [qw( package )],
meta => { remote => $remote },
rows => [map {
my $package = $_;
columns => \@columns,
title => "$package Installations",
id => ['packages-apt-by-package', $package],
+ rowid => [qw( remote )],
meta => { package => $package },
rows => [ map {
my $remote = $_;
return +{
title => 'Perl Installations',
id => 'perls',
+ rowid => [qw( remote location )],
columns => [
{ key => 'remote', label => 'Remote' },
{ key => 'hostname', label => 'Hostname' },
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 => (
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 _publish_page {
- my ($self, $reports, $page, $options) = @_;
+ my ($self, $reports, $page_name, $options) = @_;
my $sorted = $self->_sort_reports($reports, $options->{report} || []);
- print $self->_render_page($sorted);
-# print $self->render_report($_)
-# for @$sorted;
+ my $page = $self->get_page($page_name);
+ $page->update($sorted);
+ $self->put_page($page);
return 1;
}
package System::Introspector::Report::Publish::MediaWiki::Connection;
use Moo;
-sub get { }
+sub get {
+ my ($self, $page_name) = @_;
+}
-sub put { }
+sub put {
+ my ($self, $page) = @_;
+}
1;
package System::Introspector::Report::Publish::MediaWiki::Page;
use Moo;
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Parser';
+use aliased 'System::Introspector::Report::Publish::MediaWiki::Producer';
+use aliased 'System::Introspector::Report::Updater';
+
+has name => (is => 'ro', required => 1);
has timestamp => (is => 'ro', required => 1);
-has content => (is => 'ro', required => 1);
+has content => (is => 'rwp', required => 1);
+
+my $_producer = Producer->new;
+my $_parser = Parser->new;
+my $_updater = Updater->new;
sub update {
my ($self, $update_stream) = @_;
+ my $original_stream = $_parser->parse($self->content);
+ my $merged_stream = $_updater->merge($original_stream, $update_stream);
+ $self->_set_content($_producer->render($merged_stream));
+ return 1;
}
1;
sub render {
my ($self, $stream) = @_;
- return join "\n", map {
+ return $self->_clear_body(join "\n", map {
ref($_) ? $self->_render_table($_) : $_;
- } @$stream;
+ } @$stream);
+}
+
+sub _clear_body {
+ my ($self, $string) = @_;
+ $string =~ s{\n\n+}{\n\n}g;
+ return $string;
}
sub _wrap {
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 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;
};
},
});
- });
+ })->memoize;
}
+my $_trim = sub {
+ my $string = shift;
+ $string =~ s{(?:^\s+|\s+$)}{}g;
+ return $string;
+};
+
sub _apply_table_head {
my ($self, $markup, $report) = @_;
my @cols = @{$report->{columns}};
->repeat('th', [map {
my $col_idx = $_;
my $col = $cols[$_];
+ my $label = $col->{label};
sub {
$_->apply_if($col->{key} !~ m{^__}, sub {
$_->add_to_attribute('th', class => 'si-colhead-' . $col->{key});
})
- ->replace_content('th', $col->{label})
+ ->replace_content('th', defined($label) ? $label->$_trim : 'Unnamed')
->apply_if($col_idx != $#cols, sub {
$_->add_after('th', "\n ");
});
};
} 0 .. $#cols ])
+ ->memoize;
}
+my $_template = do {
+ local $/;
+ scalar <DATA>;
+};
+
sub _load_markup {
- return HTML::Zoom->from_html(do {
- local $/;
- scalar <DATA>;
- });
+ return HTML::Zoom->from_html($_template);
}
1;
--- /dev/null
+package System::Introspector::Report::Updater;
+use Moo;
+
+my $_flatten_id = sub {
+ my $value = $_[0];
+ return ref($value) ? join("\0", @$value) : $value;
+};
+
+sub merge {
+ my ($self, $original, $update) = @_;
+ my $old = $self->_map_reports_by_id($original);
+ my $new = $self->_map_reports_by_id($update);
+ my %add = map { ($_ => $new->{$_}) } grep { not($old->{$_}) } keys %$new;
+ return $self->_weave_additional([ map {
+ (ref($_) eq 'HASH') ? do {
+ my $report = $_;
+ my $id = $report->{id}->$_flatten_id;
+ $new->{$id}
+ ? $self->_merge_reports($report, $new->{$id})
+ : $report;
+ } : $_;
+ } @$original ], \%add, $self->_calc_sequence($update));
+}
+
+sub _weave_additional {
+ my ($self, $stream, $additional, $sequence) = @_;
+ my @items = @$stream;
+ if (my $begin = $sequence->{''}) {
+ if (my $item = delete $additional->{$begin}) {
+ unshift @items, $item;
+ }
+ }
+ my @done;
+ while (defined( my $item = shift @items )) {
+ if (ref($item) eq 'HASH') {
+ my $item_id = $item->{id}->$_flatten_id;
+ if (my $after = $sequence->{$item_id}) {
+ if (my $insert = $additional->{$after}) {
+ unshift @items, $insert;
+ }
+ }
+ }
+ push @done, $item;
+ }
+ return \@done;
+}
+
+sub _calc_sequence {
+ my ($self, $stream) = @_;
+ my @ids = map {
+ $_->{id}->$_flatten_id;
+ } grep {
+ ref($_) eq 'HASH';
+ } @$stream;
+ my %sequence;
+ for my $index (0 .. $#ids) {
+ $sequence{ $index ? $ids[$index - 1] : '' } = $ids[$index];
+ }
+ return \%sequence;
+}
+
+sub _merge_reports {
+ my ($self, $original, $update) = @_;
+ my $rowid = $update->{rowid};
+ my $ident = sub {
+ my $row = shift;
+ join "\0", map $row->{$_}, @$rowid;
+ };
+ my %current;
+ $current{$_->$ident} = $_
+ for @{$original->{rows}};
+ return {
+ title => $update->{title},
+ id => $update->{id},
+ rowid => $update->{rowid},
+ meta => $update->{meta} || {},
+ columns => [
+ @{$update->{columns}},
+ (grep {
+ $_->{key} =~ m{^__};
+ } @{$original->{columns}}),
+ ],
+ rows => [ map {
+ my $row = $_;
+ my $id = $row->$ident;
+ +{ %{$current{$id}||{}}, %$row };
+ } @{$update->{rows}} ],
+ };
+}
+
+sub _map_reports_by_id {
+ my ($self, $stream) = @_;
+ return {
+ map {
+ ($_->{id}->$_flatten_id, $_);
+ } grep {
+ ref($_) eq 'HASH';
+ } @$stream,
+ };
+}
+
+1;
--- /dev/null
+Previous text.
+
+<!-- SI:TITLE begin foo:a -->
+== Foo X ==
+<!-- SI:TITLE end foo:a -->
+
+User description.
+
+<!-- SI:TABLE begin foo:a -->
+<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:a -->
+
+More text.
+
+<!-- SI:TITLE begin foo:c -->
+== Foo Y ==
+<!-- SI:TITLE end foo:c -->
+
+User description.
+
+<!-- SI:TABLE begin foo:c -->
+<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:c -->
+
+End Text
--- /dev/null
+Previous text.
+
+<!-- SI:TITLE begin foo:a -->
+== Foo A ==
+<!-- SI:TITLE end foo:a -->
+
+<!-- SI:TABLE begin foo:a -->
+<table class="si-report">
+ <tr>
+ <th class="si-colhead-bar">Bar</th>
+ <th class="si-colhead-baz">Baz</th>
+ <th>Qux</th>
+ <th>Unnamed</th>
+ </tr>
+ <tr class="data-row">
+ <td class="si-column-bar">231</td>
+ <td class="si-column-baz">421</td>
+ <td>171</td>
+ <td></td>
+ </tr><tr class="data-row">
+ <td class="si-column-bar">232</td>
+ <td class="si-column-baz">884</td>
+ <td>172</td>
+ <td>173</td>
+ </tr><tr class="data-row">
+ <td class="si-column-bar">332</td>
+ <td class="si-column-baz">784</td>
+ <td></td>
+ <td></td>
+ </tr>
+</table>
+<!-- SI:TABLE end foo:a -->
+
+<!-- SI:TITLE begin foo:b -->
+== Foo B ==
+<!-- SI:TITLE end foo:b -->
+
+<!-- SI:TABLE begin foo:b -->
+<table class="si-report">
+ <tr>
+ <th class="si-colhead-bar">Bar</th>
+ <th class="si-colhead-baz">Baz</th>
+ </tr>
+ <tr class="data-row">
+ <td class="si-column-bar">231</td>
+ <td class="si-column-baz">421</td>
+ </tr><tr class="data-row">
+ <td class="si-column-bar">332</td>
+ <td class="si-column-baz">784</td>
+ </tr>
+</table>
+<!-- SI:TABLE end foo:b -->
+
+More text.
+
+<!-- SI:TITLE begin foo:c -->
+== Foo C ==
+<!-- SI:TITLE end foo:c -->
+
+<!-- SI:TABLE begin foo:c -->
+<table class="si-report">
+ <tr>
+ <th class="si-colhead-bar">New Bar</th>
+ <th class="si-colhead-baz">New Baz</th>
+ <th>Qux</th>
+ <th>Unnamed</th>
+ </tr>
+ <tr class="data-row">
+ <td class="si-column-bar">232</td>
+ <td class="si-column-baz">884</td>
+ <td>172</td>
+ <td>173</td>
+ </tr><tr class="data-row">
+ <td class="si-column-bar">332</td>
+ <td class="si-column-baz">784</td>
+ <td></td>
+ <td></td>
+ </tr>
+</table>
+<!-- SI:TABLE end foo:c -->
+
+End Text
\ No newline at end of file
--- /dev/null
+use strictures 1;
+use Test::More;
+use IO::All;
+use FindBin;
+
+use aliased 'System::Introspector::Report::Publish::MediaWiki';
+
+my %result;
+
+do {
+ package TestConnection;
+ use Moo;
+ use IO::All;
+ use aliased 'System::Introspector::Report::Publish::MediaWiki::Page';
+
+ sub get {
+ my ($self, $name) = @_;
+ return Page->new(
+ name => $name,
+ timestamp => 23,
+ content => scalar(io("$FindBin::Bin/data/$name.txt")->slurp),
+ );
+ }
+
+ sub put {
+ my ($self, $page) = @_;
+ $result{$page->name} = $page->content;
+ }
+};
+
+my $conn = TestConnection->new;
+my $wiki = MediaWiki->new(
+ connection => $conn,
+ page => {
+ foo => {
+ report => ['foo:*'],
+ },
+ },
+);
+
+ok $wiki->publish([
+ { id => [qw( foo a )],
+ title => "Foo A",
+ rowid => ['bar'],
+ columns => [
+ { key => 'bar', label => 'Bar' },
+ { key => 'baz', label => 'Baz' },
+ ],
+ rows => [
+ { bar => 231, baz => 421 },
+ { bar => 232, baz => 884 },
+ { bar => 332, baz => 784 },
+ ],
+ },
+ { id => [qw( foo b )],
+ title => "Foo B",
+ rowid => ['bar'],
+ columns => [
+ { key => 'bar', label => 'Bar' },
+ { key => 'baz', label => 'Baz' },
+ ],
+ rows => [
+ { bar => 231, baz => 421 },
+ { bar => 332, baz => 784 },
+ ],
+ },
+ { id => [qw( foo c )],
+ title => "Foo C",
+ rowid => ['bar'],
+ columns => [
+ { key => 'bar', label => 'New Bar' },
+ { key => 'baz', label => 'New Baz' },
+ ],
+ rows => [
+ { bar => 232, baz => 884 },
+ { bar => 332, baz => 784 },
+ ],
+ },
+]), 'publish ok';
+
+my $_despace = sub {
+ my $string = shift;
+ $string =~ s{[\s\n]+}{}g;
+ return $string;
+};
+
+## uncomment to regenerate result file
+# do { no warnings; $result{foo} > io("$FindBin::Bin/data/result/foo.txt") };
+
+is $result{foo}->$_despace,
+ scalar(io("$FindBin::Bin/data/result/foo.txt")->slurp)->$_despace,
+ 'resulting page looks correct';
+
+done_testing;
projects / scpubgit/System-Introspector-Report.git / commitdiff