Punk-Observe
view release on metacpan or search on metacpan
t/0910-backend.t view on Meta::CPAN
cmp_ok($w->{cols}, '<=', 6, 'cols is clamped to a grid that exists');
}
# A PANEL IS VALIDATED BY THE PARSER THAT WILL RUN IT, before it is stored, so
# the dashboard page never has to apologise for a panel it saved.
{
my ($db) = fresh();
$C->can('save_dashboard')->($db, 'default', { slug => 'ops', title => 'Ops' });
my $good = $C->can('save_panel')->($db, 'default', 'ops', {
title => 'errors', viz => 'bar', span => 2,
query => 'log | where severity >= error | count' });
ok($good->{ok}, 'a panel with a valid query saves');
my $bad = $C->can('save_panel')->($db, 'default', 'ops',
{ title => 'x', query => 'log | wat' });
ok($bad->{refused}, 'a panel whose query does not parse is refused');
like($bad->{error}, qr/stage/,
" with the PARSER's own message, not a generic one");
my $nodash = $C->can('save_panel')->($db, 'default', 'nope',
{ title => 'x', query => 'log' });
ok($nodash->{refused}, 'a panel on a dashboard that is not there is refused');
# Round trip, with viz and span intact - the two the renderer reads.
my $d = $C->can('dashboards')->($db, 'default', 'ops');
is(scalar @{ $d->{panels} }, 1, 'the panel is read back');
is($d->{panels}[0]{viz}, 'bar', ' with its visualisation');
is($d->{panels}[0]{span}, 2, ' and its span');
is($d->{panels}[0]{query}, 'log | where severity >= error | count',
' and its query, unchanged');
}
# --- the two engines describe the same schema -------------------------------
#
# The DDL used to live here as well as in sqitch/, and this asserted the two
# agreed - which was an admission rather than a solution: it existed because
# they could disagree, and a third copy in the demo had already drifted to
# five of the nine tables it should have had.
#
# There is one description now, but there are two ENGINES, and PostgreSQL and
# SQLite cannot share a script: BIGSERIAL and JSONB have no SQLite spelling.
# So the drift that remains possible is between them, and that is what is
# asserted here. A column added to one engine only is a failing build.
{
my %tables;
my %cols;
for my $engine (qw(pg sqlite)) {
my $f = "sqitch/$engine/deploy/alerts.sql";
ok(-f $f, "the $engine change script ships");
my $sql = do { open my $fh, '<', $f or die "$f: $!"; local $/; <$fh> };
while ($sql =~ /CREATE\s+TABLE\s+(?:IF\s+NOT\s+EXISTS\s+)?(\w+)\s*\((.*?)\n\s*\);/gis) {
my ($t, $body) = (lc $1, $2);
$tables{$engine}{$t} = 1;
# A column is a name at the start of a line followed by a type.
# The words below start a CONTINUATION - a REFERENCES clause
# wrapping onto `ON DELETE CASCADE` reads as a column called `on`
# otherwise, which is a failing test with no bug behind it.
my @kw = qw(unique primary foreign check references constraint
on default not null cascade);
my %c = map { lc $_ => 1 } $body =~ /^\s+(\w+)\s+\S/gm;
delete @c{@kw};
$cols{$engine}{$t} = \%c;
}
}
is_deeply([ sort keys %{ $tables{pg} } ], [ sort keys %{ $tables{sqlite} } ],
'both engines describe the same tables')
or diag("pg only: @{[ grep { !$tables{sqlite}{$_} } sort keys %{$tables{pg}} ]}\n"
. "sqlite only: @{[ grep { !$tables{pg}{$_} } sort keys %{$tables{sqlite}} ]}");
my $bad = '';
for my $t (sort keys %{ $tables{pg} }) {
next unless $tables{sqlite}{$t};
my $p = $cols{pg}{$t} || {};
my $s = $cols{sqlite}{$t} || {};
my @only_p = grep { !$s->{$_} } sort keys %$p;
my @only_s = grep { !$p->{$_} } sort keys %$s;
$bad .= "$t: pg only @only_p; sqlite only @only_s\n"
if @only_p || @only_s;
}
is($bad, '', ' with the same columns on every one of them') or diag($bad);
}
done_testing();
( run in 0.976 second using v1.01-cache-2.11-cpan-e7c6538aa59 )