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 )