in automation/tinc/main/ext/atmsort.pl [958:1491]
sub format_query_output
{
my ($fqostate, $has_order, $outarr, $directive) = @_;
my $prefix = "";
$directive = {} unless (defined($directive));
$fqostate->{count} += 1;
if ($glob_verbose)
{
print "GP_IGNORE: start fqo $fqostate->{count}\n";
}
if (exists($directive->{make_equiv_expected}))
{
# special case for EXPLAIN PLAN as first "query"
if (exists($directive->{explain}))
{
my $stat = format_explain($outarr, $directive);
# save the first query output from equiv as "expected rows"
if ($stat)
{
push @{$equiv_expected_rows}, @{$stat};
}
else
{
push @{$equiv_expected_rows}, @{$outarr};
}
if ($glob_verbose)
{
print "GP_IGNORE: end fqo $fqostate->{count}\n";
}
return ;
}
# save the first query output from equiv as "expected rows"
push @{$equiv_expected_rows}, @{$outarr};
}
elsif (defined($equiv_expected_rows)
&& scalar(@{$equiv_expected_rows}))
{
# reuse equiv expected rows if you have them
$outarr = [];
push @{$outarr}, @{$equiv_expected_rows};
}
# explain (if not in an equivalence region)
if (exists($directive->{explain}))
{
format_explain($outarr, $directive);
if ($glob_verbose)
{
print "GP_IGNORE: end fqo $fqostate->{count}\n";
}
return;
}
$prefix = "GP_IGNORE:"
if (exists($directive->{ignore}));
if (exists($directive->{sortlines}))
{
my $firstline = $directive->{firstline};
my $ordercols = $directive->{order};
my $mvdlist = $directive->{mvd};
# lines already have newline terminator, so just rejoin them.
my $lines = join ("", @{$outarr});
my $ah1 = tablelizer($lines, $firstline);
unless (defined($ah1) && scalar(@{$ah1}))
{
# print "No tablelizer hash for $lines, $firstline\n";
# print STDERR "No tablelizer hash for $lines, $firstline\n";
if ($glob_verbose)
{
print "GP_IGNORE: end fqo $fqostate->{count}\n";
}
return;
}
my @allcols = sort (keys(%{$ah1->[0]}));
my @presortcols;
if (defined($ordercols) && length($ordercols))
{
# $ordercols =~ s/^.*order\s*//;
$ordercols =~ s/\n//gm;
$ordercols =~ s/\s//gm;
@presortcols = split(/\s*\,\s*/, $ordercols);
}
my @mvdcols;
my @mvd_deps;
my @mvd_nodeps;
my @mvdspec;
if (defined($mvdlist) && length($mvdlist))
{
$mvdlist =~ s/\n//gm;
$mvdlist =~ s/\s//gm;
# find all the mvd specifications (separated by semicolons)
my @allspecs = split(/\;/, $mvdlist);
# print "allspecs:", Data::Dumper->Dump(\@allspecs);
for my $item (@allspecs)
{
my $realspec;
# split the specification list, separating the
# specification columns on the left hand side (LHS)
# from the "dependent" columns on the right hand side (RHS)
my @colset = split(/\-\>/, $item, 2);
unless (scalar(@colset) == 2)
{
print "invalid colset for $item\n";
print STDERR "invalid colset for $item\n";
next;
}
# specification columns (LHS)
my @scols = split(/\,/, $colset[0]);
unless (scalar(@scols))
{
print "invalid dependency specification: $colset[0]\n";
print STDERR
"invalid dependency specification: $colset[0]\n";
next;
}
# dependent columns (RHS)
my @dcols = split(/\,/, $colset[1]);
unless (scalar(@dcols))
{
print "invalid specified dependency: $colset[1]\n";
print STDERR "invalid specified dependency: $colset[1]\n";
next;
}
$realspec = {};
my $scol2 = [];
my $dcol2 = [];
my $sdcol = [];
$realspec->{spec} = $item;
push @{$scol2}, @scols;
push @{$dcol2}, @dcols;
push @{$sdcol}, @scols, @dcols;
$realspec->{scol} = $scol2;
$realspec->{dcol} = $dcol2;
$realspec->{allcol} = $sdcol;
push @mvdcols, @scols, @dcols;
# find all the dependent columns
push @mvd_deps, @dcols;
push @mvdspec, $realspec;
}
# find all the mvd cols which are *not* dependent. Need
# to handle the case of self-dependency, eg "mvd 1->1", so
# must build set of all columns, then strip out the
# "dependent" cols. So this is the set of all LHS columns
# which are never on the RHS.
my %get_nodeps;
for my $col (@mvdcols)
{
$get_nodeps{$col} = 1;
}
# remove dependent cols
for my $col (@mvd_deps)
{
if (exists($get_nodeps{$col}))
{
delete $get_nodeps{$col};
}
}
# now sorted and unique, with no dependents
@mvd_nodeps = sort (keys(%get_nodeps));
# print "mvdspec:", Data::Dumper->Dump(\@mvdspec);
# print "mvd no deps:", Data::Dumper->Dump(\@mvd_nodeps);
}
my %unsorth;
for my $col (@allcols)
{
$unsorth{$col} = 1;
}
# clear sorted column list if just "order 0"
if ((1 == scalar(@presortcols))
&& ($presortcols[0] eq "0"))
{
@presortcols = ();
}
for my $col (@presortcols)
{
if (exists($unsorth{$col}))
{
delete $unsorth{$col};
}
}
for my $col (@mvdcols)
{
if (exists($unsorth{$col}))
{
delete $unsorth{$col};
}
}
my @unsortcols = sort(keys(%unsorth));
# print Data::Dumper->Dump([$ah1]);
if (scalar(@presortcols))
{
my $hd1 = "sorted columns " . join(", ", @presortcols);
print $hd1, "\n", "-"x(length($hd1)), "\n";
for my $h_row (@{$ah1})
{
my @collist;
@collist = ();
# print "hrow:",Data::Dumper->Dump([$h_row]), "\n";
for my $col (@presortcols)
{
# print "col: ($col)\n";
if (exists($h_row->{$col}))
{
push @collist, $h_row->{$col};
}
else
{
my $maxcol = scalar(@allcols);
my $errstr =
"specified ORDER column out of range: $col vs $maxcol\n";
print $errstr;
print STDERR $errstr;
last;
}
}
print $prefix, join(' | ', @collist), "\n";
}
}
if (scalar(@mvdspec))
{
my @outi;
my $hd1 = "multivalue dependency specifications";
print $hd1, "\n", "-"x(length($hd1)), "\n";
for my $mspec (@mvdspec)
{
$hd1 = $mspec->{spec};
print $hd1, "\n", "-"x(length($hd1)), "\n";
for my $h_row (@{$ah1})
{
my @collist;
@collist = ();
# print "hrow:",Data::Dumper->Dump([$h_row]), "\n";
for my $col (@{$mspec->{allcol}})
{
# print "col: ($col)\n";
if (exists($h_row->{$col}))
{
push @collist, $h_row->{$col};
}
else
{
my $maxcol = scalar(@allcols);
my $errstr =
"specified MVD column out of range: $col vs $maxcol\n";
print $errstr;
print STDERR $errstr;
last;
}
}
push @outi, join(' | ', @collist);
}
my @ggg= sort @outi;
for my $line (@ggg)
{
print $prefix, $line, "\n";
}
@outi = ();
}
}
my $hd2 = "unsorted columns " . join(", ", @unsortcols);
# the "unsorted" comparison must include all columns which are
# not sorted or part of an mvd specification, plus the sorted
# columns, plus the non-dependent mvd columns which aren't
# already in the list
if ((scalar(@presortcols))
|| scalar(@mvd_nodeps))
{
if (scalar(@presortcols))
{
if (scalar(@mvd_deps))
{
my %get_presort;
for my $col (@presortcols)
{
$get_presort{$col} = 1;
}
# remove "dependent" (RHS) columns
for my $col (@mvd_deps)
{
if (exists($get_presort{$col}))
{
delete $get_presort{$col};
}
}
# now sorted and unique, minus all mvd dependent cols
@presortcols = sort (keys(%get_presort));
}
if (scalar(@presortcols))
{
$hd2 .= " ( " . join(", ", @presortcols) . ")";
# have to compare all columns as unsorted
push @unsortcols, @presortcols;
}
}
if (scalar(@mvd_nodeps))
{
my %get_nodeps;
for my $col (@mvd_nodeps)
{
$get_nodeps{$col} = 1;
}
# remove "nodeps" which are already in the output list
for my $col (@unsortcols)
{
if (exists($get_nodeps{$col}))
{
delete $get_nodeps{$col};
}
}
# now sorted and unique, minus all unsorted/sorted cols
@mvd_nodeps = sort (keys(%get_nodeps));
if (scalar(@mvd_nodeps))
{
$hd2 .= " (( " . join(", ", @mvd_nodeps) . "))";
# have to compare all columns as unsorted
push @unsortcols, @mvd_nodeps;
}
}
}
print $hd2, "\n", "-"x(length($hd2)), "\n";
my @finalunsort;
if (scalar(@unsortcols))
{
for my $h_row (@{$ah1})
{
my @collist;
@collist = ();
for my $col (@unsortcols)
{
if (exists($h_row->{$col}))
{
push @collist, $h_row->{$col};
}
else
{
my $maxcol = scalar(@allcols);
my $errstr =
"specified UNSORT column out of range: $col vs $maxcol\n";
print $errstr;
print STDERR $errstr;
last;
}
}
push @finalunsort, join(' | ', @collist);
}
my @ggg= sort @finalunsort;
for my $line (@ggg)
{
print $prefix, $line, "\n";
}
}
if ($glob_verbose)
{
print "GP_IGNORE: end fqo $fqostate->{count}\n";
}
return;
} # end order
if ($has_order)
{
my @ggg= @{$outarr};
if ($glob_ignore_whitespace)
{
my @ggg2;
for my $line (@ggg)
{
# remove all leading, trailing whitespace (changes sorting)
# and whitespace around column separators
$line =~ s/^\s+//;
$line =~ s/\s+$//;
$line =~ s/\|\s+/\|/gm;
$line =~ s/\s+\|/\|/gm;
$line .= "\n" # replace linefeed if necessary
unless ($line =~ m/\n$/);
push @ggg2, $line;
}
@ggg= @ggg2;
}
if ($glob_orderwarn)
{
# if no ordering cols specified (no directive), and
# SELECT has ORDER BY, see if number of order
# by cols matches all cols in selected lists
if (exists($directive->{sql_statement})
&& (defined($directive->{sql_statement}))
&& ($directive->{sql_statement} =~ m/select.*order.*by/is))
{
my $fl2 = $directive->{firstline};
my $sql_statement = $directive->{sql_statement};
$sql_statement =~ s/\n/ /gm;
my @ocols =
($sql_statement =~ m/select.*order.*by\s+(.*)\;/is);
# print Data::Dumper->Dump(\@ocols);
# lines already have newline terminator, so just rejoin them.
my $line2 = join ("", @{$outarr});
my $ah2 = tablelizer($line2, $fl2);
my @allcols2;
# print Data::Dumper->Dump([$ah2]);
@allcols2 = (keys(%{$ah2->[0]}))
if (defined($ah2) && scalar(@{$ah2}));
# treat the order by cols as a column separated list,
# and count them. works ok for simple ORDER BY clauses
if (scalar(@ocols))
{
my $ocolstr = shift @ocols;
my @ocols2 = split (/\,/, $ocolstr);
if (scalar(@ocols2) < scalar(@allcols2))
{
print "GP_IGNORE: ORDER_WARNING: OUTPUT ",
scalar(@allcols2), " columns, but ORDER BY on ",
scalar(@ocols2), " \n";
}
}
}
} # end if $glob_orderwarn
for my $line (@ggg)
{
print $dpref, $prefix, $line;
}
}
else
{
my @ggg= sort @{$outarr};
if ($glob_ignore_whitespace)
{
my @ggg2;
for my $line (@ggg)
{
# remove all leading, trailing whitespace (changes sorting)
# and whitespace around column separators
$line =~ s/^\s+//;
$line =~ s/\s+$//;
$line =~ s/\|\s+/\|/gm;
$line =~ s/\s+\|/\|/gm;
$line .= "\n" # replace linefeed if necessary
unless ($line =~ m/\n$/);
push @ggg2, $line;
}
@ggg= sort @ggg2;
}
for my $line (@ggg)
{
print $bpref, $prefix, $line;
}
}
if ($glob_verbose)
{
print "GP_IGNORE: end fqo $fqostate->{count}\n";
}
}