in automation/tinc/main/ext/atmsort.pl [1494:1897]
sub bigloop
{
my $sql_statement = "";
my @outarr;
my $getrows = 0;
my $getstatement = 0;
my $has_order = 0;
my $copy_select = 0;
my $directive = {};
my $big_ignore = 0;
my $define_match_expression = undef;
my $verzion = "unknown";
if (q$Revision: #1 $ =~ /\d+/)
{
$verzion = do { my @r = (q$Revision: #1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
}
my $format_fix = << "EOF_formatfix";
))}
EOF_formatfix
# NOTE: define $format_fix with HERE document just to fix emacs
# indenting due to comment char in Q expression...
$verzion = $0 . " version " . $verzion;
print "GP_IGNORE: formatted by $verzion\n";
my $do_equiv = $glob_compare_equiv || $glob_make_equiv_expected;
L_bigwhile:
while (<>) # big while
{
my $ini = $_;
# look for match/substitution or match/ignore expressions
if (defined($define_match_expression))
{
unless (($ini =~ m/\-\-\s*end\_match(subs|ignore)\s*$/i))
{
$define_match_expression .= $ini;
goto L_push_outarr;
}
my @foo = split(/\n/, $define_match_expression, 2);
unless (2 == scalar(@foo))
{
$ini .= "GP_IGNORE: bad match definition\n";
undef $define_match_expression;
goto L_push_outarr;
}
my $stat;
my $doc1 = $foo[1];
# strip off leading comment characters
$doc1 =~ s/^\s*\-\-//gm;
if ($foo[0] =~ m/subs/)
{
$stat = _build_match_subs($doc1, "USER");
}
else
{
$stat = _build_match_ignores($doc1, "USER");
}
if (scalar(@{$stat}) > 1)
{
my $outi = $stat->[1];
# print a message showing the error
$outi =~ s/^(.*)/GP_IGNORE: ($1)/gm;
$ini .= $outi;
}
else
{
$ini .= "GP_IGNORE: defined new match expression\n";
}
undef $define_match_expression;
goto L_push_outarr;
} # end defined match expression
if ($big_ignore > 0)
{
if (($ini =~ m/\-\-\s*end\_equiv\s*$/i) && !($do_equiv))
{
$big_ignore -= 1;
}
if ($ini =~ m/\-\-\s*end\_ignore\s*$/i)
{
$big_ignore -= 1;
}
print "GP_IGNORE:", $ini;
next;
}
elsif (($ini =~ m/\-\-\s*end\_equiv\s*$/i) && $do_equiv)
{
$equiv_expected_rows = undef;
}
if ($ini =~ m/\-\-\s*end\_head(er|ers|ing|ings)\_ignore\s*$/i)
{
$glob_ignore_headers = 0;
}
if ($getrows) # getting rows from SELECT output
{
# special case for copy select
if ($copy_select &&
($ini =~ m/(\-\-)|(ERROR)/))
{
my @ggg= sort @outarr;
for my $line (@ggg)
{
print $bpref, $line;
}
@outarr = ();
$getrows = 0;
$has_order = 0;
$copy_select = 0;
next;
}
# regex example: (5 rows)
if ($ini =~ m/^\s*\(\d+\s+row(s)*\)\s*$/)
{
format_query_output($glob_fqo,
$has_order, \@outarr, $directive);
# Always ignore the rowcount for explain plan out as the skeleton plans might be the
# same even if the row counts differ because of session level GUCs.
if (exists($directive->{explain}))
{
$ini = "GP_IGNORE:" . $ini;
}
$directive = {};
@outarr = ();
$getrows = 0;
$has_order = 0;
}
}
else # finding SQL statement or start of SELECT output
{
if (($ini =~ m/\-\-\s*start\_match(subs|ignore)\s*$/i))
{
$define_match_expression = $ini;
goto L_push_outarr;
}
if (($ini =~ m/\-\-\s*start\_ignore\s*$/i) ||
(($ini =~ m/\-\-\s*start\_equiv\s*$/i) && !($do_equiv)))
{
$big_ignore += 1;
for my $line (@outarr)
{
print $apref, $line;
}
@outarr = ();
print "GP_IGNORE:", $ini;
next;
}
elsif (($ini =~ m/\-\-\s*start\_equiv\s*$/i) &&
$glob_make_equiv_expected)
{
$equiv_expected_rows = [];
$directive->{make_equiv_expected} = 1;
}
if ($ini =~ m/\-\-\s*start\_head(er|ers|ing|ings)\_ignore\s*$/i)
{
$glob_ignore_headers = 1;
}
# Note: \d is for the psql "describe"
if ($ini =~ m/(insert|update|delete|select|\\d|copy)/i)
{
$copy_select = 0;
$has_order = 0;
$sql_statement = "";
if ($ini =~ m/explain.*(insert|update|delete|select)/i)
{
$directive->{explain} = "normal";
}
}
if ($ini =~ m/\-\-\s*force\_explain\s+operator.*$/i)
{
# ENGINF-137: force_explain
$directive->{explain} = "operator";
}
if ($ini =~ m/\-\-\s*force\_explain\s*$/i)
{
# ENGINF-137: force_explain
$directive->{explain} = "normal";
}
if ($ini =~ m/\-\-\s*ignore\s*$/i)
{
$directive->{ignore} = "ignore";
}
if ($ini =~ m/\-\-\s*order\s+\d+.*$/i)
{
my $olist = $ini;
$olist =~ s/^.*\-\-\s*order//;
$directive->{order} = $olist;
}
if ($ini =~ m/\-\-\s*mvd\s+\d+.*$/i)
{
my $olist = $ini;
$olist =~ s/^.*\-\-\s*mvd//;
$directive->{mvd} = $olist;
}
if ($ini =~ m/select/i)
{
$getstatement = 1;
}
if ($getstatement)
{
$sql_statement .= $ini;
}
if ($ini =~ m/\;/) # statement terminator
{
$getstatement = 0;
}
# prune notices with segment info if they are duplicates
# if ($ini =~ m/^\s*(NOTICE|ERROR|HINT|DETAIL|WARNING)\:.*\s+\(seg.*pid.*\)/)
if ($ini =~ m/^\s*(NOTICE|ERROR|HINT|DETAIL|WARNING)\:/)
{
$ini =~ s/\s+(\W)?(\W)?\(seg.*pid.*\)//;
# also remove line numbers from errors
$ini =~ s/\s+(\W)?(\W)?\(\w+\.[ch]:\d+\)/ (SOMEFILE:SOMEFUNC)/;
my $outsize = scalar(@outarr);
my $lastguy = -1;
L_checkfor:
for my $jj (1..$outsize)
{
my $checkstr = $outarr[$lastguy];
#remove trailing spaces for comparison
$checkstr =~ s/\s+$//;
my $skinny = $ini;
$skinny =~ s/\s+$//;
# stop when no more notices
last L_checkfor
if ($checkstr !~ m/^\s*(NOTICE|ERROR|HINT|DETAIL|WARNING)\:/);
# discard this line if matches a previous notice
if ($skinny eq $checkstr)
{
if (0) # debug code
{
$ini = "DUP: " . $ini;
last L_checkfor;
}
next L_bigwhile;
}
$lastguy--;
} # end for
} # end if pruning notices
# MPP-1492 allow:
# copy (select ...) to stdout
# \copy (select ...) to stdout
# and special case these guys:
# copy test1 to stdout
# \copy test1 to stdout
#
# ENGINF-129:
# and "copy...; -- copy_stdout " for copy.out
my $copysel_regex =
'^\s*((.copy.*test1.*to stdout)|(copy.*test1.*to stdout\;)|(copy.*\;\s*\-\-\s*copy\_stdout))';
# regex example: ---- or ---+---
# need at least 3 dashes to avoid confusion with "--" comments
if (($ini =~ m/^\s*((\-\-)(\-)+(\+(\-)+)*)+\s*$/)
# special case for copy select
|| (($ini =~ m/$copysel_regex/i)
&& ($ini !~ m/order\s+by/i)))
{ # sort this region
$directive->{firstline} = $outarr[-1];
if (exists($directive->{order}) ||
exists($directive->{mvd}))
{
$directive->{sortlines} = $outarr[-1];
}
# special case for copy select
if ($ini =~ m/$copysel_regex/i)
{
# print "copy select: $ini\n";
$copy_select = 1;
$sql_statement = "";
}
# special case for explain
if (exists($directive->{explain}) &&
($ini =~ m/^\s*((\-\-)(\-)+(\+(\-)+)*)+\s*$/) &&
($outarr[-1] =~ m/QUERY PLAN/))
{
# ENGINF-88: fixup explain headers
$outarr[-1] = "QUERY PLAN\n";
$ini = ("_" x length($outarr[-1])) . "\n";
if ($glob_ignore_headers)
{
$ini = "GP_IGNORE:" . $ini;
}
}
$getstatement = 0;
# ENGINF-180: ignore header formatting
# the last line of the outarr is the first line of the header
if ($glob_ignore_headers && $outarr[-1])
{
$outarr[-1] = "GP_IGNORE:" . $outarr[-1];
}
for my $line (@outarr)
{
print $apref, $line;
}
@outarr = ();
# ENGINF-180: ignore header formatting
# the current line is the last line of the header
if ($glob_ignore_headers
&& ($ini =~ m/^\s*((\-\-)(\-)+(\+(\-)+)*)+\s*$/))
{
$ini = "GP_IGNORE:" . $ini;
}
print $apref, $ini;
if (defined($sql_statement)
&& length($sql_statement)
# multiline match
&& ($sql_statement =~ m/select.*order.*by/is))
{
$has_order = 1; # so do *not* sort output
# $sql_statement =~ s/\n/ /gm;
# print "has order: ", $sql_statement, "\n";
$directive->{sql_statement} = $sql_statement;
}
else
{
$has_order = 0; # need to sort query output
# $sql_statement =~ s/\n/ /gm;
# print "no order: ", $sql_statement, "\n";
$directive->{sql_statement} = $sql_statement;
}
$sql_statement = "";
$getrows = 1;
next;
} # end sort this region
} # end finding SQL
# if MATCH then SUBSTITUTE
# see HERE document for definitions
$ini = match_then_subs($ini);
# if MATCH then IGNORE
# see HERE document for definitions
if ( match_then_ignore($ini))
{
next; # ignore matching lines
}
L_push_outarr:
push @outarr, $ini;
} # end big while
for my $line (@outarr)
{
print $cpref, $line;
}
} # end bigloop