| #!/usr/bin/env perl |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| use Pod::Usage; |
| use Getopt::Long; |
| use Data::Dumper; |
| use strict; |
| use warnings; |
| |
| =head1 NAME |
| |
| B<explain.pl> - parse and reformat Postgres EXPLAIN output |
| |
| =head1 SYNOPSIS |
| |
| B<explain> [options] filename |
| |
| Options: |
| |
| -help brief help message |
| -man full documentation |
| -option formatting option: perl, yaml, dot, query, jpg, json |
| -querylist list of queries |
| -direction direction of query plan graph: LR, RL, TB or BT. |
| -colorscheme graph color scheme |
| -timeline rank nodes by start offset time (experimental) |
| -prune prune tree attributes |
| -output output filename (else output to STDOUT). |
| -statcolor statistics coloring (experimental) |
| -edge edge decorations |
| |
| =head1 OPTIONS |
| |
| =over 8 |
| |
| =item B<-help> |
| |
| Print a brief help message and exits. |
| |
| =item B<-man> |
| |
| Prints the manual page and exits. |
| |
| =item B<-option> |
| |
| Choose the output format option. Several formats are supported. |
| |
| =over 12 |
| |
| =item perl: output in perl L<Data::Dumper> format. |
| |
| =item yaml: output in L<yaml.org> machine and human-readable format |
| |
| =item dot: output in dot graphical language for L<graphiz.org> graphing tool. |
| |
| =item querytext: output the text of the query (only useful for TPC-H) |
| |
| =item jpg: pipe the dot output thru the dot formatter (if it is installed) to get jpg output directly. (May also support bmp, ps, pdf, png) |
| |
| =item json: output in L<json.org> machine and human-readable format |
| |
| =back |
| |
| |
| =item B<-querylist> |
| |
| A list of queries to process. The query numbering is 1-based. Some |
| valid forms are: |
| |
| -querylist 1 |
| -querylist=2 |
| --ql=3,4,5 |
| --ql=6-9 |
| |
| or some combination. By default, all queries are processed. |
| |
| |
| =item B<-direction> |
| |
| Direction of data flow in query plan graph. Valid entries are: |
| |
| =over 12 |
| |
| =item BT (default): bottom to top |
| |
| =item TB: top to bottom |
| |
| =item LR: left to right |
| |
| =item RL: right to left |
| |
| =back |
| |
| =item B<-colorscheme> |
| |
| One of the supported ColorBrewer(TM) color schemes. Use |
| -color ? |
| to get a list of the valid schemes, and |
| -color dump |
| to output a dot file displaying all the valid schemes. |
| |
| Colors from www.ColorBrewer.org by Cynthia A. Brewer, Geography, |
| Pennsylvania State University. |
| |
| =item B<-prune> |
| |
| Prune tree attributes. The only supported option is "stats" to |
| remove the to_end and to_first timing information. |
| |
| =item B<-output> |
| |
| Output file name. If multiple queries are processed, the filename |
| is used as a template to generate multiple files. If the filename |
| has an extension, it is preserved, else an extension is supplied |
| based upon the formatting option. The filename template inserts |
| the query number before the "dot" (.) if more than one query was |
| processed. |
| |
| =item B<-statcolor> |
| |
| For an EXPLAIN ANALYZE plan, color according to the time spent in |
| node. Red is greatest, and blue is least. For statcolor=ts (default), |
| the node edge is colored by time, and the node interior is filled |
| by slice color. For statcolor=st, the color scheme is reversed. |
| For statcolor=t (timing only), the entire node is colored according |
| to the time spent. |
| |
| =item B<-edge> |
| |
| Decorate graph edges with row count if available. Valid entries are: |
| |
| =over 12 |
| |
| =item long - print average rows and number of workers |
| |
| =item medium - print average rows and number of workers compactly |
| |
| =item short - print total row counts |
| |
| =back |
| |
| |
| =back |
| |
| =head1 DESCRIPTION |
| |
| explain.pl reads EXPLAIN output from a text file (or standard |
| input) and formats it in several ways. The text file must contain |
| output in one of the the following formats. The first is a regular |
| EXPLAIN format, starting the the QUERY PLAN header and ending with the |
| number of rows in parentheses. Indenting must be on: |
| |
| QUERY PLAN |
| ---------------------------------------------------------------------------------------------------------- |
| Gather Motion 64:1 (slice2) (cost=6007722.78..6007722.79 rows=6 width=51) |
| Merge Key: partial_aggregation.l_returnflag, partial_aggregation.l_linestatus |
| -> Sort (cost=6007722.78..6007722.79 rows=6 width=51) |
| Sort Key: partial_aggregation.l_returnflag, partial_aggregation.l_linestatus |
| -> HashAggregate (cost=6007722.52..6007722.70 rows=6 width=51) |
| Group By: lineitem.l_returnflag, lineitem.l_linestatus |
| -> Redistribute Motion 64:64 (slice1) (cost=6007721.92..6007722.31 rows=6 width=51) |
| Hash Key: lineitem.l_returnflag, lineitem.l_linestatus |
| -> HashAggregate (cost=6007721.92..6007722.19 rows=6 width=51) |
| Group By: lineitem.l_returnflag, lineitem.l_linestatus |
| -> Seq Scan on lineitem (cost=0.00..3693046.50 rows=92587017 width=51) |
| Filter: l_shipdate <= '1998-09-08 00:00:00'::timestamp without time zone |
| (12 rows) |
| |
| |
| The second acceptable format is the TPC-H EXPLAIN ANALYZE, listing |
| each query followed by the EXPLAIN output delineated by vertical bars |
| ('|', e.g. |QUERY PLAN| ): |
| |
| EXPLAIN ANALYZE |
| |
| |
| select |
| l_returnflag, |
| l_linestatus, |
| sum(l_quantity) as sum_qty, |
| sum(l_extendedprice) as sum_base_price, |
| sum(l_extendedprice * (1 - l_discount)) as sum_disc_price, |
| sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge, |
| avg(l_quantity) as avg_qty, |
| avg(l_extendedprice) as avg_price, |
| avg(l_discount) as avg_disc, |
| count(*) as count_order |
| from |
| lineitem |
| where |
| l_shipdate <= date '1998-12-01' - interval '106 day' |
| group by |
| l_returnflag, |
| l_linestatus |
| order by |
| l_returnflag, |
| l_linestatus; |
| |
| |
| Query 1 complete, 19 rows returned |
| |
| |
| |QUERY PLAN| |
| |Gather Motion 64:1 (slice2) (cost=5990545.19..5990545.21 rows=6 width=51)| |
| | recv: Total 4 rows with 1294937 ms to end.| |
| | Merge Key: partial_aggregation.junk_attr_1, partial_aggregation.junk_attr_2| |
| | -> Sort (cost=5990545.19..5990545.21 rows=6 width=51)| |
| | Avg 1.00 rows x 4 workers. Max 1 rows (seg49) with 1294938 ms to end.| |
| | Sort Key: partial_aggregation.junk_attr_1, partial_aggregation.junk_attr_2| |
| | -> HashAggregate (cost=5990544.94..5990545.12 rows=6 width=51)| |
| | Avg 1.00 rows x 4 workers. Max 1 rows (seg49) with 1294933 ms to end.| |
| | Group By: lineitem.l_returnflag, lineitem.l_linestatus| |
| | -> Redistribute Motion 64:64 (slice1) (cost=5990544.34..5990544.73 rows=6 width=51)| |
| | recv: Avg 64.00 rows x 4 workers. Max 64 rows (seg49) with 1277197 ms to first row, 1294424 ms to end.| |
| | Hash Key: lineitem.l_returnflag, lineitem.l_linestatus| |
| | -> HashAggregate (cost=5990544.34..5990544.61 rows=6 width=51)| |
| | Avg 4.00 rows x 64 workers. Max 4 rows (seg44) with 1292222 ms to end.| |
| | Group By: lineitem.l_returnflag, lineitem.l_linestatus| |
| | -> Seq Scan on lineitem (cost=0.00..3693046.50 rows=91899913 width=51)| |
| | Avg 91914578.95 rows x 64 workers. Max 91914598 rows (seg13) with 14.694 ms to first row, 258614 ms to end.| |
| | Filter: l_shipdate <= '1998-08-17 00:00:00'::timestamp without time zone| |
| |1295317.560 ms elapsed| |
| |
| Time was 1295.33 seconds. Query ended at Thu Oct 12 12:09:27 2006 |
| |
| =head1 CAVEATS/LIMITATIONS |
| |
| If explain.pl uses Graphviz to graph the query plan, it may flip the |
| left and right children of a join to obtain a more balanced pictorial |
| representation. Use the -edge option to label graph edges to |
| correctly identify the left and right children. |
| |
| =head1 AUTHORS |
| |
| Apache HAWQ |
| |
| Address bug reports and comments to: dev@hawq.apache.org |
| |
| =cut |
| |
| # IMPLEMENTATION NOTES: |
| # |
| # EXPLAIN ANALYZE final statistics in analyze_node: |
| # |
| # The final statistics look like this: |
| # |
| # Slice statistics: |
| # (slice0) Executor memory: 472K bytes. |
| # (slice1) Executor memory: 464K bytes avg x 2 workers, 464K bytes max (seg0). |
| # Settings: |
| # |
| # Total runtime: 52347.493 ms |
| # |
| # The "Settings" entry is optional (ie, it only exists if you change the |
| # settings in your session). If the "Settings" entry is missing explain.pl |
| # adds a dummy entry to the statistics. This technique is a bit easier |
| # than changing the parser to handle both cases. |
| # |
| # Parse_node: |
| # InitPlan entries in greenplum are in separate slices, so explain.pl |
| # prefixes them with an arrow (and adds a fake cost) to make them |
| # look like a top-level execution node. Again, this technique was |
| # easier than modifying the parser to special case InitPlan. |
| # |
| # Plan parsing in general: |
| # The original code only dealt with the TPCH formatted output: |
| # |QUERY PLAN| |
| # |Gather Motion 64:1 (slice2) (cost=5990545.19..5990545.21 rows=6 width=51)| |
| # | recv: Total 4 rows with 1294937 ms to end.| |
| # | Merge Key: partial_aggr.junk_attr_1, partial_aggr.junk_attr_2| |
| # | -> Sort (cost=5990545.19..5990545.21 rows=6 width=51)| |
| # | Avg 1.00 rows x 4 workers. Max 1 rows (seg49) with 1294 ms to end.| |
| # |
| # It was easier to modify the parser to wrap the input with missing bars |
| # than handle two cases (are you sensing a pattern here?). |
| # |
| # "Magic" Mode: |
| # This mode just adds an output filename option and constructs jpgs |
| # |
| # Output File Name: |
| # The guts of the formatting code always write to STDOUT, so this code |
| # resets STDOUT to the filename of choice. |
| # |
| # treemap: |
| # This routine applies a function over the entire parse tree |
| # |
| # OLAP fixups: |
| # OLAP queries have duplicate Shared Scan and Multi Slice Motion nodes. |
| # explain.pl only fixes them up for dot output, but not for yaml, perl, etc. |
| # The rationale is that dot handle digraphs nicely, but yaml and perl are |
| # more suitable for tree output. |
| # |
| |
| my $glob_id = ""; |
| |
| my $glob_optn; |
| my $glob_qlist; |
| my $glob_direction; |
| my $glob_timeline; |
| my $glob_prune; |
| my $glob_outi; |
| my $glob_statcolor; |
| my $glob_edge; |
| |
| my $GV_formats; # graphviz output formats |
| |
| my %glob_coltab; |
| |
| my %glob_divcol; |
| |
| my $glob_colorscheme; |
| BEGIN { |
| |
| $GV_formats = '^(jpg|bmp|ps|pdf|png)$'; |
| |
| # table of valid "qualitative" color schemes |
| |
| %glob_coltab = (set312 => [ |
| '#8DD3C7', |
| '#FFFFB3', |
| '#BEBADA', |
| '#FB8072', |
| '#80B1D3', |
| '#FDB462', |
| '#B3DE69', |
| '#FCCDE5', |
| '#D9D9D9', |
| '#BC80BD', |
| '#CCEBC5', |
| '#FFED6F' |
| ], |
| paired12 => [ |
| '#a6cee3', |
| '#1f78b4', |
| '#b2df8a', |
| '#33a02c', |
| '#fb9a99', |
| '#e31a1c', |
| '#fdbf6f', |
| '#ff7f00', |
| '#cab2d6', |
| '#6a3d9a', |
| '#ffff99', |
| '#b15928' |
| ], |
| pastel19 => [ |
| '#fbb4ae', |
| '#b3cde3', |
| '#ccebc5', |
| '#decbe4', |
| '#fed9a6', |
| '#ffffcc', |
| '#e5d8bd', |
| '#fddaec', |
| '#f2f2f2' |
| ], |
| pastel24 => [ |
| '#b3e2cd', |
| '#fdcdac', |
| '#cbd5e8', |
| '#f4cae4', |
| '#e6f5c9', |
| '#fff2ae', |
| '#f1e2cc', |
| '#cccccc' |
| ], |
| set19 => [ |
| '#e41a1c', |
| '#377eb8', |
| '#4daf4a', |
| '#984ea3', |
| '#ff7f00', |
| '#ffff33', |
| '#a65628', |
| '#f781bf', |
| '#999999' |
| ], |
| set28 => [ |
| '#66c2a5', |
| '#fc8d62', |
| '#8da0cb', |
| '#e78ac3', |
| '#a6d854', |
| '#ffd92f', |
| '#e5c494', |
| '#b3b3b3' |
| ], |
| original => [ |
| 'azure', |
| 'cornsilk', |
| 'lavender', |
| 'mintcream', |
| 'mistyrose', |
| 'lightgray', |
| 'salmon', |
| 'goldenrod', |
| 'cyan' |
| ], |
| ); |
| |
| # diverging color schemes |
| |
| %glob_divcol = ( |
| rdbu11 => [ |
| '#67001f', |
| '#b2182b', |
| '#d6604d', |
| '#f4a582', |
| '#fddac7', |
| '#f6f6f6', |
| '#d1e5f0', |
| '#92c5de', |
| '#4393c3', |
| '#2166ac', |
| '#053061' |
| ], |
| ); |
| |
| } |
| |
| sub qlist_fixup |
| { |
| my $qlist = shift; |
| |
| my @outi; |
| |
| for my $qnum (@{$qlist}) |
| { |
| if ($qnum =~ m/^\d+$/) |
| { |
| push @outi, $qnum; |
| } |
| else |
| { |
| if ($qnum =~ m/^\d+\-\d+$/) |
| { |
| my $expr = $qnum; |
| $expr =~ s/\-/\.\./; |
| |
| eval "for my \$val ($expr) { push \@outi, \$val; }"; |
| } |
| else |
| { |
| die("Invalid format for querylist: \'$qnum\'\n"); |
| exit(1); |
| } |
| |
| } |
| |
| } |
| |
| return \@outi; |
| |
| } |
| |
| |
| # dump a nice graph listing all of the color schemes (neato is preferred) |
| sub dodumpcolor |
| { |
| my $coltab = shift; |
| my $fh = shift; |
| |
| my @ggg = sort(keys(%{$coltab})); |
| |
| # centered, with lines (not arrows) |
| print $fh "digraph plan1 { graph [center=\"root\",root=\"root\"] ;\n edge [dir=none]\n"; |
| |
| # adjust the lengths to avoid overlap |
| for my $ii (0..(scalar(@ggg)-1)) |
| { |
| print $fh '"root" -> "' . $ii. '"' . " [len=2];\n"; |
| |
| my $jj = 0; |
| |
| for my $cc (@{$coltab->{$ggg[$ii]}}) |
| { |
| print $fh '"' . $ii. '" -> "' . $ii. "." . $jj. '"' |
| . " [len=1];\n"; |
| $jj++; |
| } |
| } |
| |
| print $fh '"root" [label="color schemes"]' . ";\n"; |
| |
| for my $ii (0..(scalar(@ggg)-1)) |
| { |
| print $fh '"' . $ii . '" [label="' . $ggg[$ii] . '"]' . ";\n"; |
| |
| my $jj = 0; |
| |
| for my $cc (@{$coltab->{$ggg[$ii]}}) |
| { |
| print $fh '"' . $ii . "." . $jj . |
| '" [label="", style=filled, ' . |
| 'fillcolor="' . $cc . '"]' . ";\n"; |
| $jj++; |
| } |
| } |
| print $fh "\n}\n"; |
| |
| } |
| |
| |
| BEGIN { |
| my $man = 0; |
| my $help = 0; |
| my $optn = "YAML"; |
| my $dir = "BT"; |
| my $DEFAULT_COLOR = "set28"; |
| my $colorscheme = $DEFAULT_COLOR; |
| my $timeline = ''; |
| my $prune; |
| my $outfile; |
| my $statcol; |
| my $edgescheme; |
| |
| my @qlst; |
| |
| GetOptions( |
| 'help|?' => \$help, man => \$man, |
| "querylist|ql|list:s" => \@qlst, |
| "option|operation=s" => \$optn, |
| "direction:s" => \$dir, |
| "colorscheme:s" => \$colorscheme, |
| "timeline" => \$timeline, |
| "prune:s" => \$prune, |
| "output:s" => \$outfile, |
| "statcolor:s" => \$statcol, |
| "edge:s" => \$edgescheme) |
| or pod2usage(2); |
| |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1) if $help; |
| pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man; |
| |
| $glob_optn = $optn; |
| $glob_optn = "jpg" if ($glob_optn =~ m/^jpeg/i); |
| |
| $glob_timeline = $timeline; |
| $glob_prune = $prune; |
| $glob_outi = $outfile; |
| $glob_statcolor = $statcol; |
| |
| $glob_edge = $edgescheme; |
| |
| if ($dir !~ m/^(TB|BT|LR|RL)$/i) |
| { |
| $glob_direction = "BT"; |
| } |
| else |
| { |
| $glob_direction = uc($dir); |
| } |
| |
| $colorscheme = lc($colorscheme); |
| |
| # print "color: $colorscheme\n"; |
| |
| if (exists($glob_coltab{$colorscheme})) |
| { |
| $glob_colorscheme = $colorscheme; |
| } |
| else |
| { |
| if ($colorscheme =~ m/list|dump/i) |
| { |
| use IO::File; |
| use POSIX qw(tmpnam); |
| |
| my ($tmpnam, $tmpfh); |
| |
| for (;;) { |
| $tmpnam = tmpnam(); |
| sysopen($tmpfh, $tmpnam, O_RDWR | O_CREAT | O_EXCL) && last; |
| } |
| |
| # write to a temporary file |
| dodumpcolor(\%glob_coltab, $tmpfh); |
| |
| close $tmpfh; |
| |
| my $catcmd = "cat $tmpnam"; |
| |
| # format with neato if jpg was specified |
| if ($glob_optn =~ m/$GV_formats/i) |
| { |
| my $dotapp = "/Applications/Graphviz.app/Contents/MacOS/neato"; |
| |
| if ($^O !~ m/darwin/) |
| { |
| $dotapp = `which neato`; |
| chomp($dotapp); |
| } |
| if (defined($dotapp) && length($dotapp) && (-e $dotapp)) |
| { |
| $catcmd .= " | $dotapp -T$glob_optn"; |
| } |
| } |
| |
| system($catcmd); |
| |
| unlink $tmpnam; |
| |
| exit(0); |
| } |
| else |
| { |
| my $colorschemelist = join("\n", sort(keys(%glob_coltab))) . "\n"; |
| |
| # identify the default color |
| $colorschemelist =~ |
| s/$DEFAULT_COLOR/$DEFAULT_COLOR \(default\)/gm; |
| |
| print "\nvalid color schemes are:\n"; |
| print $colorschemelist; |
| print "\nUse: \"explain.pl -color dump -opt jpg > graph.jpg\"\n"; |
| print "to construct a JPEG showing all the valid color schemes.\n"; |
| print "\nColors from www.ColorBrewer.org by Cynthia A. Brewer, Geography,\nPennsylvania State University.\n\n"; |
| |
| exit(0); |
| } |
| } |
| |
| @qlst = split(/,/,join(',', @qlst)); |
| |
| $glob_qlist = qlist_fixup(\@qlst); |
| |
| # print "loading...\n" ; |
| } |
| |
| sub analyze_node |
| { |
| my ($node, $parse_ctx) = @_; |
| |
| if (defined($node) && exists($node->{txt})) |
| { |
| |
| # gather analyze statistics if it exists in this node... |
| if ($node->{txt} =~ |
| m/Slice\s+statistics.*(Settings.*)*Total\s+runtime/s) |
| { |
| my $t1 = $node->{txt}; |
| |
| # NOTE: the final statistics look something like this: |
| |
| # Slice statistics: |
| # (slice0) Executor memory: 472K bytes. |
| # (slice1) Executor memory: 464K bytes avg x 2 workers, 464K bytes max (seg0). |
| # Settings: |
| # Total runtime: 52347.493 ms |
| |
| # (we've actually added some vertical bars so it might look |
| # like this): |
| # || Slice statistics: |
| # || (slice0) Executor memory: 472K bytes. |
| |
| # NB: the "Settings" entry is optional, so |
| # add Settings if they are missing |
| unless ($t1 =~ |
| m/Slice\s+statistics.*Settings.*Total\s+runtime/s) |
| { |
| $t1 =~ |
| s/\n.*\s+Total\s+runtime/\n Settings\: \n Total runtime/; |
| } |
| |
| my @foo = ($t1 =~ m/Slice\s+statistics\:\s+(.*)\s+Settings\:\s+(.*)\s+Total\s+runtime:\s+(.*)\s+ms/s); |
| |
| if (scalar(@foo) == 3) |
| { |
| my $mem = shift @foo; |
| my $sett = shift @foo; |
| my $runt = shift @foo; |
| |
| $mem =~ s/\|\|//gm; # remove '||'... |
| $sett =~ s/\|\|//gm; |
| |
| my $statstuff = {}; |
| |
| my @baz = split(/\n/, $mem); |
| my $sliceh = {}; |
| for my $elt (@baz) |
| { |
| my @ztesch = ($elt =~ m/(slice\d+)/); |
| next unless (scalar(@ztesch)); |
| $elt =~ s/\s*\(slice\d+\)\s*//; |
| my $val = shift @ztesch; |
| $sliceh->{$val} = $elt; |
| } |
| |
| $statstuff->{memory} = $sliceh; |
| $statstuff->{settings} = $sett; |
| $statstuff->{runtime} = $runt; |
| $parse_ctx->{explain_analyze_stats} = $statstuff; |
| $node->{statistics} = $statstuff; |
| } |
| } |
| |
| my @short = $node->{txt} =~ m/\-\>\s*(.*)\s*\(cost\=/; |
| $node->{short} = shift @short; |
| |
| unless(exists($node->{id})) |
| { |
| print Data::Dumper->Dump([$node]), "\n"; |
| } |
| |
| if ($node->{id} == 1) |
| { |
| @short = $node->{txt} =~ m/^\s*\|\s*(.*)\s*\(cost\=/; |
| $node->{short} = shift @short; |
| |
| # handle case where dashed line might have wrapped... |
| unless (defined($node->{short}) && length($node->{short})) |
| { |
| # might not be first line... |
| @short = $node->{txt} =~ m/\s*\|\s*(.*)\s*\(cost\=/; |
| $node->{short} = shift @short; |
| } |
| |
| |
| } |
| |
| # handle case of "cost-free" txt (including a double || |
| # and not first line, or screwed-up parse of short as a single bar |
| # |
| # example: weird initplan like: |
| # || -> InitPlan (slice49) |
| if (defined($node->{short}) && length($node->{short}) |
| && ($node->{short} =~ m/\s*\|\s*/)) |
| { |
| $node->{short} = ""; |
| } |
| |
| unless (defined($node->{short}) && length($node->{short})) |
| { |
| @short = $node->{txt} =~ m/\s*\|(\|)?\s*(\w*)\s*/; |
| $node->{short} = shift @short; |
| |
| if (defined($node->{short}) && length($node->{short}) |
| && ($node->{short} =~ m/\s*\|\s*/)) |
| { |
| $node->{short} = ""; |
| } |
| |
| # last try!! |
| unless (defined($node->{short}) && length($node->{short})) |
| { |
| my $foo = $node->{txt}; |
| $foo =~ s/\-\>//gm; |
| $foo =~ s/\|//gm; |
| $foo =~ s/^\s+//gm; |
| $foo =~ s/\s+$//gm; |
| $node->{short} = $foo; |
| } |
| |
| # print "long: $node->{txt}\n"; |
| # print "short: $node->{short}\n"; |
| } |
| |
| $node->{short} =~ s/\s*$//; |
| |
| # remove quotes which mess up dot file |
| $node->{short} =~ s/\"//gm; |
| |
| # print "long: $node->{txt}\n"; |
| # print "short: $node->{short}\n"; |
| |
| # XXX XXX XXX XXX: FINAL "short" fixups |
| while (defined($node->{short}) && length($node->{short}) |
| && ($node->{short} =~ m/(\n)|^\s+|\s+$|(\(cost\=)/m)) |
| { |
| # remove leading and trailing spaces... |
| $node->{short} =~ s/^\s*//; |
| $node->{short} =~ s/\s*$//; |
| |
| # remove newlines |
| $node->{short} =~ s/(\n).*//gm; |
| |
| # remove cost=... |
| $node->{short} =~ s/\(cost\=.*//gm; |
| |
| # print "short fixup: $node->{short}\n\n\n"; |
| } |
| |
| { |
| if ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*end)/i) |
| { |
| |
| my @ggg = |
| ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*end)/i); |
| |
| # print join('*', @ggg), "\n"; |
| |
| my $tt = $ggg[0]; |
| |
| $node->{to_end} = $tt; |
| |
| $parse_ctx->{alltimes}->{$tt} = 1; |
| |
| if (exists($parse_ctx->{h_to_end}->{$tt})) |
| { |
| push @{$parse_ctx->{h_to_end}->{$tt}}, '"'. $node->{id} .'"'; |
| } |
| else |
| { |
| $parse_ctx->{h_to_end}->{$tt} = ['"'. $node->{id} . '"']; |
| } |
| |
| |
| |
| } |
| if ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*first\s*row)/i) |
| { |
| |
| my @ggg = |
| ($node->{txt} =~ m/(\d+(\.\d*)?)(\s*ms\s*to\s*first\s*row)/i); |
| |
| # print join('*', @ggg), "\n"; |
| |
| my $tt = $ggg[0]; |
| |
| $node->{to_first} = $tt; |
| |
| $parse_ctx->{alltimes}->{$tt} = 1; |
| |
| if (exists($parse_ctx->{h_to_first}->{$tt})) |
| { |
| push @{$parse_ctx->{h_to_first}->{$tt}}, '"' . $node->{id} . '"' ; |
| } |
| else |
| { |
| $parse_ctx->{h_to_first}->{$tt} = [ '"' . $node->{id} . '"']; |
| } |
| |
| } |
| |
| if ($node->{txt} =~ m/start offset by (\d+(\.\d*)?)(\s*ms)/i) |
| { |
| |
| my @ggg = |
| ($node->{txt} =~ m/start offset by (\d+(\.\d*)?)(\s*ms)/i); |
| |
| # print join('*', @ggg), "\n"; |
| |
| my $tt = $ggg[0]; |
| |
| $node->{to_startoff} = $tt; |
| |
| $parse_ctx->{allstarttimes}->{$tt} = 1; |
| |
| if (exists($parse_ctx->{h_to_startoff}->{$tt})) |
| { |
| push @{$parse_ctx->{h_to_startoff}->{$tt}}, '"'. $node->{id} .'"'; |
| } |
| else |
| { |
| $parse_ctx->{h_to_startoff}->{$tt} = ['"'. $node->{id} . '"']; |
| } |
| } |
| |
| if (exists($node->{to_end})) |
| { |
| $node->{total_time} = |
| (exists($node->{to_first})) ? |
| ($node->{to_end} - $node->{to_first}) : |
| $node->{to_end}; |
| } |
| |
| |
| } |
| |
| if (1) |
| { |
| if (exists($node->{child})) |
| { |
| delete $node->{child} |
| unless (defined($node->{child}) |
| && scalar(@{$node->{child}})); |
| } |
| } |
| |
| |
| } |
| |
| } |
| |
| sub parse_node |
| { |
| |
| my ($ref_id, $parse_ctx, $depth, $plan_rows, $parent) = @_; |
| |
| # print "depth: $depth\n"; |
| # print "row: ",$plan_rows->[0],"\n" if (scalar(@{$plan_rows})); |
| |
| # print "first: $first\n" if defined ($first); |
| |
| my $spclen = undef; |
| my $node = undef; |
| |
| my $no_more_text = 0; |
| |
| while (scalar(@{$plan_rows})) |
| { |
| my $row = $plan_rows->[0]; |
| |
| unless (defined($node)) |
| { |
| $node = {}; |
| |
| $node->{child} = []; |
| |
| $node->{txt} = ""; |
| |
| $node->{parent} = $parent |
| if (defined($parent)); |
| |
| my $id = $$ref_id; |
| $id++; |
| $$ref_id= $id; |
| $node->{id} = $id; |
| } |
| |
| # XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX |
| # make initplan into a fake node so the graphs look nicer (eg |
| # tpch query 15). Prefix it with an arrow and add a fake cost. |
| if ($row =~ m/\|(\s)*InitPlan(.*)slice/) |
| { |
| $row =~ s/InitPlan/\-\> InitPlan/; |
| if ($row !~ m/\(cost=/) |
| { |
| $row =~ s/\|$/\(cost=\?\)|/; |
| } |
| } |
| |
| if ($row !~ m/\|(\s)*\-\>/) |
| { |
| # add text to existing node |
| |
| if ($no_more_text) |
| { |
| print "error: no more text for ". $node->{id}, "\n"; |
| } |
| |
| $node->{txt} .= "\n" . $row; |
| |
| # print "txt: $node->{txt}\n"; |
| |
| shift @{$plan_rows}; |
| next; |
| } |
| else |
| { |
| # new node |
| unless ($no_more_text) |
| { |
| unless (length($node->{txt})) |
| { |
| $node->{txt} .= $row; |
| shift @{$plan_rows}; |
| next; |
| } |
| } |
| |
| # match the leading spaces before the '->', eg: |
| # "| -> Sort (cost=5990545.19..599..." |
| |
| my @spc = ($row =~ m/\|(\s*)\-\>/); |
| |
| # print "space match:", Data::Dumper->Dump(\@spc), "\n"; |
| |
| $spclen = scalar(@spc) ? length($spc[0]) : 0; |
| |
| # print "space len: $spclen, depth: $depth\n"; |
| |
| if ($spclen > $depth) |
| { |
| # found a child |
| push @{$node->{child}}, parse_node($ref_id, $parse_ctx, |
| $spclen, $plan_rows, |
| $node->{id}); |
| } |
| |
| } |
| |
| if (defined($spclen)) |
| { |
| if ($spclen <= $depth) |
| { # found a sibling or parent |
| # need to put the row back on the head of the list |
| |
| if (defined($node) && exists($node->{txt})) |
| { |
| analyze_node($node, $parse_ctx); |
| |
| return $node; |
| } |
| } |
| } |
| else |
| { |
| die ("what the heck?"); |
| } |
| |
| $spclen = undef; |
| $no_more_text = 1; |
| |
| } # end while |
| |
| if (defined($node)) |
| { |
| analyze_node($node, $parse_ctx); |
| } |
| |
| return $node; |
| |
| } |
| |
| |
| if (1) |
| { |
| |
| my @bigarr; |
| |
| my $state = "INIT"; |
| |
| my $pair = undef; |
| |
| my ($query, $plan); |
| |
| my $tpch_format=0; |
| my $bigdash = '-' x 40; # make big dash smaller |
| |
| my $magic; |
| |
| for (<>) |
| { |
| my $ini = $_; |
| |
| if ($state =~ m/INIT/) |
| { |
| if ($ini !~ m/(^EXPLAIN ANALYZE)|(QUERY PLAN)/) |
| { |
| next; |
| } |
| |
| $query = ""; |
| $plan = ""; |
| $pair = {}; |
| |
| if ($ini =~ m/^EXPLAIN ANALYZE/) |
| { |
| $tpch_format = 1; |
| $state = "GETQUERY"; |
| next; |
| } |
| |
| if ($ini =~ m/QUERY PLAN/) |
| { |
| $tpch_format = 0; |
| $plan = ""; |
| $state = "GETPLAN"; |
| next; |
| } |
| |
| } |
| |
| if ($state !~ m/GETPLAN/) |
| { |
| # should be START or GETQUERY only... |
| if ($tpch_format) |
| { |
| if ($ini =~ m/^EXPLAIN ANALYZE/) |
| { |
| if (defined($pair)) |
| { |
| $pair->{plan} = $plan; |
| $pair->{query} = $query; |
| push @bigarr, $pair; |
| } |
| $pair = {}; |
| $query = ""; |
| $plan = ""; |
| $state = "GETQUERY"; |
| next; |
| } |
| } |
| else |
| { |
| # not tpch analyze |
| if ($ini =~ m/QUERY PLAN/) |
| { |
| if (defined($pair)) |
| { |
| $pair->{plan} = $plan; |
| $pair->{query} = $query; |
| push @bigarr, $pair; |
| } |
| $pair = {}; |
| $query = ""; |
| $plan = ""; |
| $state = "GETPLAN"; |
| next; |
| } |
| |
| } |
| if ($state =~ m/GETQUERY/) |
| { |
| if ($ini =~ m/QUERY PLAN/) |
| { |
| if (!($tpch_format)) |
| { |
| if (defined($pair)) |
| { |
| $pair->{plan} = $plan; |
| $pair->{query} = $query; |
| push @bigarr, $pair; |
| } |
| $pair = {}; |
| $query = ""; |
| } |
| |
| $plan = ""; |
| $state = "GETPLAN"; |
| next; |
| } |
| |
| $query .= $ini; |
| } |
| |
| } # end not getplan |
| |
| if ($state =~ m/GETPLAN/) |
| { |
| |
| if ($tpch_format) |
| { |
| if ($ini !~ m/\|(.*)\|/) |
| { |
| $state = "START"; |
| next; |
| } |
| } |
| else |
| { |
| if ($ini =~ m/(\(\d+\s+rows\))|(Time\s+was.*seconds\.\s+Query\s+ended)/) |
| { |
| $state = "START"; |
| next; |
| } |
| } |
| # a bit weird here -- just ignore the separator. But |
| # maybe we should invest some effort to determine that the |
| # separator is the next line after the header (and only |
| # ignore it once) ? |
| next |
| if ($ini =~ m/$bigdash/); |
| |
| # add the missing bars |
| if (!($tpch_format)) |
| { |
| if ($ini !~ m/\|(.*)\|/) |
| { |
| $ini = '|' . $ini . '|'; |
| } |
| } |
| |
| $plan .= $ini; |
| } |
| |
| } # end big for |
| if (defined($pair)) |
| { |
| $pair->{plan} = $plan; |
| $pair->{query} = $query; |
| push @bigarr, $pair; |
| } |
| |
| #print scalar(@bigarr), "\n"; |
| |
| |
| #print Data::Dumper->Dump(\@bigarr); |
| |
| #print $bigarr[0]->{plan}; |
| |
| unless(scalar(@{$glob_qlist})) |
| { |
| # build a 1-based list of queries |
| for (my $ii =1; $ii <= scalar(@bigarr); $ii++) |
| { |
| push @{$glob_qlist}, $ii; |
| } |
| } |
| |
| my $realSTDOUT; |
| |
| for my $qqq (@{$glob_qlist}) |
| { |
| my $qnum = $qqq - 1; # 0 based vs 1 based |
| |
| if ($qnum > scalar(@bigarr)) |
| { |
| warn("specified query $qqq is out-of-range -- skipping...\n"); |
| next; |
| } |
| |
| if ($glob_optn =~ m/query|text|txt/i) |
| { |
| doquery($bigarr[$qnum]->{query}); |
| next; |
| } |
| |
| my $plantxt = $bigarr[$qnum]->{plan}; |
| |
| unless (defined($plantxt) && length($plantxt)) |
| { |
| warn("invalid plan for query $qqq -- skipping...\n"); |
| next; |
| } |
| |
| #print $plantxt, "\n"; |
| |
| my @plan_r = split(/\n/, $plantxt); |
| |
| my $pr = \@plan_r; |
| |
| my $parse_ctx = {}; |
| |
| my $id = 0; |
| |
| $parse_ctx->{alltimes} = {}; |
| $parse_ctx->{h_to_end} = {}; |
| $parse_ctx->{h_to_first} = {}; |
| |
| $parse_ctx->{allstarttimes} = {}; |
| $parse_ctx->{h_to_startoff} = {}; |
| $parse_ctx->{explain_analyze_stats} = {}; |
| |
| my $plantree = parse_node(\$id, $parse_ctx, 0, $pr); |
| |
| # my @timelist = sort {$a <=> $b} keys (%{$parse_ctx->{alltimes}}); |
| my @timelist = sort {$a <=> $b} keys (%{$parse_ctx->{allstarttimes}}); |
| |
| |
| if (defined($glob_prune)) |
| { |
| if ($glob_prune =~ m/stat|heavy|heavily/i) |
| { |
| my $map_expr = 'delete $node->{to_end};'; |
| treeMap($plantree, undef, $map_expr); |
| $map_expr = 'delete $node->{to_first};'; |
| treeMap($plantree, undef, $map_expr); |
| |
| # additional statistics |
| $map_expr = 'delete $node->{to_startoff};'; |
| treeMap($plantree, undef, $map_expr); |
| $map_expr = 'delete $node->{total_time};'; |
| treeMap($plantree, undef, $map_expr); |
| $map_expr = 'delete $node->{statistics};'; |
| treeMap($plantree, undef, $map_expr); |
| } |
| if ($glob_prune =~ m/heavy|heavily/i) |
| { |
| treeMap($plantree, 'prune_heavily($node);'); |
| } |
| } |
| |
| |
| # magic mode : display everything magically |
| # |
| # NOTE: only set to magic on the first iteration, then reset |
| # to jpg, so performs correctly with multiple queries |
| if ($glob_optn =~ m/magic/i) |
| { |
| $glob_optn = "jpg"; |
| |
| use IO::File; |
| use POSIX qw(tmpnam); |
| |
| my $tmpnam; |
| |
| for (;;) { |
| my $tmpfh; |
| |
| $tmpnam = tmpnam(); |
| sysopen($tmpfh, $tmpnam, O_RDWR | O_CREAT | O_EXCL) && last; |
| } |
| |
| # create a temporary directory name -- just append ".dir" |
| # to the new tempfile name and mkdir |
| my $tmpdir = $tmpnam . ".dir"; |
| |
| mkdir($tmpdir) or die "magic failed" ; |
| |
| unlink $tmpnam; # we didn't need this tempfile anyhow |
| |
| # reset output file name to create files in the new |
| # temporary directory |
| $glob_outi = File::Spec->catfile($tmpdir, "query_"); |
| |
| $magic = $glob_outi; |
| } |
| |
| if ($glob_outi) |
| { |
| unless (defined($realSTDOUT)) |
| { |
| open $realSTDOUT, ">&STDOUT" or die "Can't dup STDOUT: $!"; |
| } |
| |
| my $outfilename = $glob_outi; |
| |
| # only need numbering if processed more than one query |
| my $neednum = (scalar(@bigarr) > 1); |
| |
| # check if name has an extension like ".foo" |
| if ($outfilename =~ m/\.(.){1,5}$/) |
| { |
| # qqq is query num (1 based) |
| |
| my $formatq = sprintf("%03d", $qqq); |
| |
| $outfilename =~ s/\.(.*)$/$formatq\.$1/ |
| if ($neednum); |
| } |
| else |
| { |
| # qqq is query num (1 based) |
| my $formatq = sprintf("%03d", $qqq); |
| |
| $outfilename .= $formatq |
| if ($neednum); |
| if ($glob_optn =~ m/yaml/i) |
| { |
| $outfilename .= ".yml"; |
| } |
| if ($glob_optn =~ m/json/i) |
| { |
| $outfilename .= ".json"; |
| } |
| if ($glob_optn =~ m/perl|dump/i) |
| { |
| $outfilename .= ".perl"; |
| } |
| if ($glob_optn =~ m/dot|graph/i) |
| { |
| $outfilename .= ".dot"; |
| } |
| if ($glob_optn =~ m/$GV_formats/i) |
| { |
| $outfilename .= ".$glob_optn"; |
| } |
| } |
| |
| close STDOUT; |
| |
| open (STDOUT, ">$outfilename" ) or die "can't open STDOUT: $!"; |
| |
| # print $outfilename, "\n"; |
| |
| } |
| |
| |
| if ($glob_optn =~ m/yaml/i) |
| { |
| doyaml($plantree); |
| } |
| if ($glob_optn =~ m/json/i) |
| { |
| doyaml($plantree, "json"); |
| } |
| if ($glob_optn =~ m/perl|dump/i) |
| { |
| doDataDump($plantree); |
| } |
| if ($glob_optn =~ m/dot|graph/i) |
| { |
| dodotfile($plantree, \@timelist, $qqq, $parse_ctx, |
| $glob_direction); |
| } |
| if ($glob_optn =~ m/operator/i) |
| { |
| doOperatorDump($plantree); |
| } |
| |
| if ($glob_optn =~ m/$GV_formats/i) |
| { |
| my $dotapp = "/Applications/Graphviz.app/Contents/MacOS/dot"; |
| |
| if ($^O !~ m/darwin/) |
| { |
| $dotapp = `which dot`; |
| chomp($dotapp); |
| } |
| die "could not find dot app: $dotapp" |
| unless (defined($dotapp) && length($dotapp) && (-e $dotapp)); |
| |
| # should have been able to redirect STDOUT thru a pipe |
| # directly to dotapp, but didn't work. Use a tmpfile |
| # instead. |
| |
| use IO::File; |
| use POSIX qw(tmpnam); |
| |
| my $tmpnam; |
| |
| for (;;) { |
| my $tmpfh; |
| |
| $tmpnam = tmpnam(); |
| sysopen($tmpfh, $tmpnam, O_RDWR | O_CREAT | O_EXCL) && last; |
| } |
| open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; |
| |
| close STDOUT; |
| open (STDOUT, ">$tmpnam" ) or die "can't open STDOUT: $!"; |
| |
| select STDOUT; $| = 1; # make unbuffered |
| |
| dodotfile($plantree, \@timelist, $qqq, $parse_ctx, |
| $glob_direction); |
| |
| close STDOUT; |
| open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!"; |
| |
| system("cat $tmpnam | $dotapp -T$glob_optn"); |
| |
| unlink $tmpnam; |
| |
| |
| } |
| } #end for querynum |
| |
| if (defined($realSTDOUT)) |
| { |
| close STDOUT; |
| open STDOUT, ">&", $realSTDOUT or die "Can't dup \$oldout: $!"; |
| |
| } |
| |
| # magically display all files |
| if (defined($magic)) |
| { |
| # only need numbering if processed more than one query |
| my $neednum = (scalar(@{$glob_qlist}) > 1); |
| |
| if ($^O =~ m/darwin/) |
| { |
| # use ImageMagick montage |
| my $ggg = $magic . '*'; |
| my $montage = `which montage`; |
| chomp($montage); |
| |
| # only perform a montage if more than one query |
| if ($neednum && defined($montage) && ( -e $montage)) |
| { |
| my $dir = $magic; |
| # get the directory name (remove "query_" prefix) |
| $dir =~ s/query_$//; |
| system("cd $dir; montage -label \'%f\' $ggg -title \"$dir\n`date`\" -shadow INDEX.html; open INDEX.html"); |
| } |
| else |
| { |
| system("open $ggg"); |
| } |
| } |
| } |
| |
| } |
| #print "\nmax id: $id\n\n"; |
| |
| # |
| |
| sub treeMap |
| { |
| my ($node, $pre_map, $post_map, $ctx) = @_; |
| |
| eval "$pre_map" |
| if (defined($pre_map)); |
| |
| if (exists($node->{child})) |
| { |
| for my $kid (@{$node->{child}}) |
| { |
| treeMap($kid, $pre_map, $post_map, $ctx); |
| } |
| } |
| eval "$post_map" |
| if (defined($post_map)); |
| } |
| |
| sub doDataDump |
| { |
| my $plantree = shift; |
| |
| |
| local $Data::Dumper::Indent = 1; |
| local $Data::Dumper::Terse = 1; |
| local $Data::Dumper::Sortkeys = 1; |
| |
| my $map_expr = 'delete $node->{txt};'; |
| # my $map_expr = 'print "foo\n"'; |
| treeMap($plantree, undef, $map_expr); |
| |
| print Data::Dumper->Dump([$plantree]); |
| } |
| |
| sub doOperatorDump |
| { |
| my $plantree = shift; |
| |
| print $plantree->{short}, "\n" if (exists($plantree->{short})); |
| |
| return |
| unless (exists($plantree->{child})); |
| |
| for my $kid (@{$plantree->{child}}) |
| { |
| doOperatorDump($kid); |
| } |
| } |
| |
| # add slice info to node |
| # and gather explain analyze stats |
| sub addslice |
| { |
| my ($node, $ctx) = @_; |
| |
| # AUTO-6: find nodes with "(slice1)" info where the slice numbers aren't |
| # part of the "Slice statistics" |
| |
| my $txt1 = $node->{txt}; |
| $txt1 =~ s/Slice statistics.*//gs; |
| |
| if ($txt1 =~ /(slice(\d+))/) |
| { |
| my @ggg = ($txt1 =~ m/(slice(\d+))/) ; |
| $node->{slice} = shift @ggg; |
| |
| # check if we have explain analyze stats for the slice |
| if (exists($ctx->{explain_analyze_stats}) |
| && exists($ctx->{explain_analyze_stats}->{memory}) |
| && exists($ctx->{explain_analyze_stats}->{memory}->{$node->{slice}})) |
| { |
| $node->{memory} = |
| $ctx->{explain_analyze_stats}->{memory}->{$node->{slice}}; |
| } |
| |
| } |
| } |
| |
| |
| sub doquery |
| { |
| my $qtxt = shift; |
| |
| print $qtxt, "\n"; |
| |
| } |
| |
| sub doyaml |
| { |
| my ($plantree, $opti) = @_; |
| |
| $opti = "yaml" unless (defined($opti)); |
| |
| if ($opti =~ m/json/i) |
| { |
| # JSON might not be installed, so test for it. |
| |
| if (eval "require JSON") |
| { |
| my $map_expr = 'delete $node->{txt};'; |
| |
| treeMap($plantree, undef, $map_expr); |
| |
| # because JSON is REQUIREd, not USEd, the symbols are not |
| # imported into the environment. |
| print JSON::objToJson($plantree, {pretty => 1, indent => 2}); |
| } |
| else |
| { |
| die("Fatal Error: The required package JSON is not installed -- please download it from www.cpan.org\n"); |
| exit(1); |
| } |
| |
| } |
| else |
| { |
| # YAML might not be installed, so test for it. |
| |
| if (eval "require YAML") |
| { |
| my $map_expr = 'delete $node->{txt};'; |
| |
| treeMap($plantree, undef, $map_expr); |
| |
| # because YAML is REQUIREd, not USEd, the symbols are not |
| # imported into the environment. |
| print YAML::Dump($plantree); |
| } |
| else |
| { |
| die("Fatal Error: The required package YAML is not installed -- please download it from www.cpan.org\n"); |
| exit(1); |
| } |
| |
| } |
| |
| } |
| |
| # remove slice numbering information to construct even more generic plans |
| sub prune_heavily |
| { |
| my $node = shift; |
| |
| return |
| unless (exists($node->{short})); |
| |
| if ($node->{short} =~ m/Delete\s*\(slice.*segment.*\)\s*\(row.*width.*\)/) |
| { |
| # QA-1309: fix strange DELETE operator formatting |
| $node->{short} = "Delete"; |
| } |
| elsif ($node->{short} =~ m/Update\s*\(slice.*segment.*\)\s*\(row.*width.*\)/) |
| { |
| # QA-1309: fix strange UPDATE operator formatting |
| $node->{short} = "Update"; |
| } |
| elsif ($node->{short} =~ m/\d+\:\d+/) |
| { |
| |
| # example: Gather Motion 8:1 (slice4); |
| |
| # strip the number of nodes and slice information |
| $node->{short} =~ s/\s+\d+\:\d+.*//; |
| |
| # Note: don't worry about removing "(slice1)" info from the |
| # "short" because addslice processes node->{text} |
| } |
| } |
| |
| # identify the slice for each node |
| # and find Shared Scan "Primary" |
| # and find MultiSliceMotion |
| sub pre_slice |
| { |
| my ($node, $ctx) = @_; |
| |
| { |
| if (scalar(@{$ctx->{a1}})) |
| { |
| my $parent = $ctx->{a1}->[-1]; |
| |
| unless (exists($node->{slice})) |
| { |
| if (exists($parent->{slice})) |
| { |
| $node->{slice} = $parent->{slice}; |
| } |
| } |
| } |
| |
| # olap stuff |
| |
| if ($node->{short} =~ m/^Shared Scan/) |
| { |
| # if the Shared Scan has a child it is the "primary" |
| if (exists($node->{child})) |
| { |
| my $share_short_fixup = $node->{short}; |
| |
| # remove the slice number from the "short" |
| $share_short_fixup =~ s/(\d+)\:/\:/g; |
| |
| if (!exists($ctx->{share_input_h}->{$share_short_fixup})) |
| { |
| $ctx->{share_input_h}->{$share_short_fixup} = $node; |
| } |
| } |
| else # not the primary, mark as a duplicate node |
| { |
| $node->{SharedScanDuplicate} = 1; |
| } |
| } |
| if ($node->{short} =~ m/^Multi Slice Motion/) |
| { |
| # choose first Multi Slice Motion node as primary |
| if (!exists($ctx->{multi_slice_h}->{$node->{short}})) |
| { |
| $ctx->{multi_slice_h}->{$node->{short}} = $node; |
| } |
| else # not the primary, mark as a duplicate node |
| { |
| $node->{MultiSliceMotionDuplicate} = 1; |
| } |
| } |
| |
| if (exists($node->{total_time})) |
| { |
| my $tt = $node->{total_time}; |
| my $tt2 = $tt * $tt; |
| $ctx->{time_stats_h}->{cnt} += 1; |
| $ctx->{time_stats_h}->{sum} += $tt; |
| $ctx->{time_stats_h}->{sumsq} += $tt2; |
| |
| if (exists($ctx->{time_stats_h}->{tt_h}->{$tt})) |
| { |
| push @{$ctx->{time_stats_h}->{tt_h}->{$tt}}, $node; |
| } |
| else |
| { |
| $ctx->{time_stats_h}->{tt_h}->{$tt} = [$node]; |
| } |
| } |
| |
| } |
| |
| push @{$ctx->{a1}}, $node; |
| |
| } |
| |
| sub post_slice |
| { |
| my ($node, $ctx) = @_; |
| |
| pop @{$ctx->{a1}}; |
| |
| } |
| |
| # make all duplicate sharedscan nodes point back to primary |
| sub sharedscan_fixup |
| { |
| my ($node, $ctx) = @_; |
| |
| if (exists($node->{SharedScanDuplicate})) |
| { |
| my $share_short_fixup = $node->{short}; |
| |
| # remove the slice number from the "short" |
| $share_short_fixup =~ s/(\d+)\:/\:/g; |
| |
| $node->{SharedScanDuplicate} = |
| $ctx->{share_input_h}->{$share_short_fixup}; |
| # $node->{id} = |
| # $node->{SharedScanDuplicate}->{id}; |
| } |
| |
| if (exists($node->{MultiSliceMotionDuplicate})) |
| { |
| $node->{MultiSliceMotionDuplicate} = |
| $ctx->{multi_slice_h}->{$node->{short}}; |
| # XXX XXX: for this case the node is really the same |
| $node->{id} = |
| $node->{MultiSliceMotionDuplicate}->{id}; |
| } |
| |
| } |
| |
| sub human_num |
| { |
| my $esti = shift; |
| |
| my @suffix = qw(K M G T P E Z Y); |
| my $suff = ""; |
| |
| # try to shorten estimate specification |
| while (length(POSIX::ceil($esti)) > 3) |
| { |
| $suff = shift @suffix; |
| |
| $esti = $esti/1000; |
| } |
| |
| if (length($suff)) |
| { |
| $esti *= 100; |
| $esti = POSIX::floor($esti+0.5); |
| $esti = $esti/100; |
| |
| $esti .= $suff; |
| } |
| |
| return $esti; |
| } |
| |
| # label left and right for nest loops |
| sub nestedloop_fixup |
| { |
| my ($node, $ctx) = @_; |
| |
| return |
| unless (exists($node->{short}) && |
| ($node->{short} =~ m/Nested Loop/)); |
| |
| my @kidlist; |
| |
| if (exists($node->{child})) |
| { |
| for my $kid (@{$node->{child}}) |
| { |
| push @kidlist, $kid; |
| } |
| } |
| |
| return |
| unless (2 == scalar(@kidlist)); |
| |
| if ($kidlist[0]->{id} < $kidlist[1]->{id}) |
| { |
| $kidlist[0]->{nested_loop_position} = "left"; |
| $kidlist[1]->{nested_loop_position} = "right"; |
| } |
| else |
| { |
| $kidlist[1]->{nested_loop_position} = "left"; |
| $kidlist[0]->{nested_loop_position} = "right"; |
| } |
| |
| } |
| |
| # find rows out information |
| sub get_rows_out |
| { |
| my ($node, $ctx, $edge) = @_; |
| |
| return |
| unless ($node->{txt} =~ m/(Rows out\:)|(\(cost\=.*\s+rows=.*\s+width\=.*\))/); |
| |
| my $long = ($edge =~ m/long|med/i); |
| |
| if ($node->{txt} =~ m/Rows out\:\s+Avg.*\s+rows\s+x\s+.*\s+workers/) |
| { |
| if (!$long) |
| { |
| # short result |
| my @foo = |
| ($node->{txt} =~ |
| m/Rows out\:\s+Avg\s+(.*)\s+rows\s+x\s+(.*)\s+workers/); |
| |
| goto L_get_est unless (2 == scalar(@foo)); |
| |
| # calculate row count as avg x num workers |
| $node->{rows_out} = $foo[0] * $foo[1]; |
| } |
| else |
| { |
| my @foo = |
| ($node->{txt} =~ |
| m/Rows out\:\s+(Avg.*workers)/); |
| |
| goto L_get_est unless (1 == scalar(@foo)); |
| |
| # just print the string |
| $node->{rows_out} = $foo[0]; |
| |
| if ($edge =~ m/med/i) |
| { |
| $node->{rows_out} =~ s/Avg\s+//; |
| $node->{rows_out} =~ s/rows\s+//; |
| $node->{rows_out} =~ s/\s*workers\s*//; |
| } |
| |
| } |
| } |
| elsif ($node->{txt} =~ m/Rows out\:\s+.*\s+rows/) |
| { |
| my @foo = |
| ($node->{txt} =~ |
| m/Rows out\:\s+(.*)\s+rows/); |
| |
| goto L_get_est unless (1 == scalar(@foo)); |
| |
| $node->{rows_out} = $foo[0]; |
| } |
| |
| if ( |
| exists($node->{rows_out}) && |
| length($node->{rows_out}) |
| ) |
| { |
| if ( |
| ($node->{rows_out} !~ m/avg/i) && |
| ($node->{rows_out} =~ m/x/)) |
| { |
| my @foo = ($node->{rows_out} =~ m/(x.*)$/); |
| |
| my $tail = $foo[0]; |
| |
| @foo = ($node->{rows_out} =~ m/(.*)\s+x.*/); |
| |
| my $head = $foo[0]; |
| |
| if (defined($tail) && defined($head)) |
| { |
| $head = human_num($head); |
| |
| $node->{rows_out} = $head . " " . $tail; |
| } |
| |
| } |
| elsif ($node->{rows_out} =~ m/^\d+$/) |
| { |
| $node->{rows_out} = human_num($node->{rows_out}); |
| } |
| } |
| |
| L_get_est: |
| |
| # add row estimates |
| if ($long && |
| ($node->{txt} =~ m/\(cost\=.*\s+rows=.*\s+width\=.*\)/)) |
| { |
| my @foo = ($node->{txt} =~ m/cost\=.*\s+rows=(\d+)\s+width\=.*/); |
| |
| if (scalar(@foo)) |
| { |
| use POSIX; |
| |
| my $esti = $foo[0]; |
| |
| $esti = human_num($esti); |
| |
| unless (exists($node->{rows_out}) && |
| length($node->{rows_out})) |
| { |
| $node->{rows_out} = ""; |
| } |
| |
| $node->{rows_out} .= " (est $esti)"; |
| } |
| } |
| |
| } # end get_rows_out |
| |
| sub calc_color_rank |
| { |
| my $ctx = shift; |
| |
| return |
| unless (defined($glob_statcolor)); |
| |
| if ($ctx->{time_stats_h}->{cnt} > 1) |
| { |
| # population variance = |
| # (sum of the squares)/n - (square of the sums)/n*n |
| my $sum = $ctx->{time_stats_h}->{sum}; |
| my $sumsq = $ctx->{time_stats_h}->{sumsq}; |
| my $enn = $ctx->{time_stats_h}->{cnt}; |
| |
| my $pop_var = ($sumsq/$enn) - (($sum*$sum)/($enn*$enn)); |
| my $std_dev = sqrt($pop_var); |
| my $mean = $sum/$enn; |
| my $half = $std_dev/2; |
| |
| # calculate a stanine (9 buckets, each 1/2 of stddev). The |
| # middle bucket (5, which is 4 if we start at zero) is |
| # centered on the mean, so it starts on mean - (1/4 stddev), |
| # and ends at mean + (1/4 stddev). |
| my @bucket; |
| my $buckstart = ($mean-($half/2))-(3*$half); |
| |
| push @bucket, 0; |
| |
| for my $ii (1..7) |
| { |
| push @bucket, $buckstart; |
| $buckstart += $half; |
| } |
| push @bucket, 2**40; # "infinity" |
| |
| my @tlist = sort {$a <=> $b} (keys %{$ctx->{time_stats_h}->{tt_h}}); |
| |
| # must have at least two |
| my $firstt = shift @tlist; |
| my $lastt = pop @tlist; |
| # print "f,l: $firstt, $lastt\n"; |
| |
| for my $nod (@{$ctx->{time_stats_h}->{tt_h}->{$firstt}}) |
| { |
| # print "first ", $nod->{id}, ": ", $nod->{short}, " - ", 0, "\n"; |
| $nod->{color_rank} = 10; |
| } |
| for my $nod (@{$ctx->{time_stats_h}->{tt_h}->{$lastt}}) |
| { |
| # print "last ", $nod->{id}, ": ", $nod->{short}, " - ", 10, "\n"; |
| $nod->{color_rank} = 1; |
| } |
| |
| # print "bucket: ", Data::Dumper->Dump(\@bucket); |
| # print "tlist: ", Data::Dumper->Dump(\@tlist); |
| # print Data::Dumper->Dump([$ctx->{time_stats_h}]); |
| |
| my $bucknum = 1; |
| for my $tt (@tlist) |
| { |
| # print "tt: $tt\n"; |
| # print "bk: $bucket[$bucknum]\n"; |
| |
| while ($tt > $bucket[$bucknum]) |
| { |
| # print "$tt > $bucket[$bucknum]\n"; |
| # last if ($bucknum >= 11); |
| $bucknum++; |
| } |
| for my $nod (@{$ctx->{time_stats_h}->{tt_h}->{$tt}}) |
| { |
| # print "node ", $nod->{id}, ": ", $nod->{short}, " - ", $bucknum, "\n"; |
| # $nod->{color_rank} = ($bucknum-1); |
| $nod->{color_rank} = (10 - $bucknum); |
| } |
| } |
| |
| } |
| |
| } |
| |
| sub dodotfile |
| { |
| my ($plantree, $time_list, $plan_num, $parse_ctx, $direction) = @_; |
| |
| { |
| my $map_expr = 'addslice($node, $ctx); '; |
| |
| treeMap($plantree, $map_expr, undef, $parse_ctx); |
| } |
| |
| |
| # $map_expr = 'propslice($node, $ctx);'; |
| my $ctx = {level => 0, a1 => [], |
| share_input_h => {}, multi_slice_h => {}, |
| time_stats_h => { cnt=>0, sum=>0, sumsq=>0, tt_h => {} } }; |
| |
| # my $map_expr = 'print "foo\n"'; |
| treeMap($plantree, |
| 'pre_slice($node, $ctx); ', |
| 'post_slice($node, $ctx); ', |
| $ctx); |
| |
| calc_color_rank($ctx); |
| |
| treeMap($plantree, |
| 'sharedscan_fixup($node, $ctx); ', |
| undef, |
| $ctx); |
| |
| # always label the left/right sides of nested loop |
| treeMap($plantree, |
| 'nestedloop_fixup($node, $ctx); ', |
| undef, |
| $ctx); |
| |
| if (defined($glob_edge) && length($glob_edge)) |
| { |
| treeMap($plantree, |
| 'get_rows_out($node, $ctx, $glob_edge); ', |
| undef, |
| $ctx); |
| } |
| |
| my $dotimeline = $glob_timeline; |
| |
| makedotfile($plantree, $time_list, $dotimeline, $plan_num, $parse_ctx, |
| $direction); |
| } |
| |
| |
| sub dotkid |
| { |
| my $node = shift; |
| |
| # XXX XXX: olap fixup - don't label duplicate multi slice motion nodes |
| return |
| if (exists($node->{MultiSliceMotionDuplicate})); |
| |
| # XXX XXX: olap fixup - have children of primary sharedscan |
| # point to this node |
| if (exists($node->{SharedScanDuplicate})) |
| { |
| for my $kid (@{$node->{SharedScanDuplicate}->{child}}) |
| { |
| print '"' . $kid->{id} . '" -> "' . $node->{id} . '"' . ";\n"; |
| } |
| } |
| |
| my $docrunch = 2; |
| |
| if (exists($node->{child})) |
| { |
| if (($docrunch != 0 ) && (scalar(@{$node->{child}} > 10))) |
| { |
| my $maxi = scalar(@{$node->{child}}); |
| |
| $maxi -= 2; |
| |
| for my $ii (2..$maxi) |
| { |
| $node->{child}->[$ii]->{crunchme} = 1; |
| } |
| |
| if ($docrunch == 2) |
| { |
| splice(@{$node->{child}}, 3, ($maxi-2)); |
| |
| $node->{child}->[2]->{short} = "... removed " . ($maxi - 3) . " nodes ..."; |
| } |
| |
| |
| } |
| |
| for my $kid (@{$node->{child}}) |
| { |
| my $edge_label = ""; |
| |
| print '"' . $kid->{id} . '" -> "' . $node->{id} . '"'; |
| |
| if (exists($kid->{nested_loop_position})) |
| { |
| $edge_label .= $kid->{nested_loop_position}; |
| } |
| |
| if (exists($kid->{rows_out})) |
| { |
| $edge_label .= " "; |
| $edge_label .= " " |
| if (length($edge_label)); |
| $edge_label .= $kid->{rows_out}; |
| } |
| |
| if (length($edge_label)) |
| { |
| print ' [label="' . $edge_label . '" ] '; |
| } |
| |
| print ";\n"; |
| } |
| |
| for my $kid (@{$node->{child}}) |
| { |
| dotkid($kid); |
| } |
| |
| } |
| |
| } |
| |
| sub dotlabel_detail |
| { |
| my $node = shift; |
| |
| # return $node->{short} ; |
| |
| my $outi = $node->{short}; |
| |
| my ($frst, $last) = (" ", " "); |
| |
| if (exists($node->{to_end})) |
| { |
| $last = "end: " . $node->{to_end}; |
| } |
| if (exists($node->{to_first})) |
| { |
| $frst = "first row: " . $node->{to_first}; |
| } |
| |
| my $slice = $node->{slice}; |
| $slice = " " |
| unless (defined($slice)); |
| |
| |
| if ((length($frst) > 1) || (length($last) > 1)) |
| { |
| my $memstuff = ""; |
| |
| # add memory statistics if have them... |
| if (exists($node->{memory})) |
| { |
| $memstuff = " | { {" . $node->{memory} . "} } "; |
| # make multiline - split on comma and "Work_mem" |
| # (using the vertical bar formatting character) |
| $memstuff =~ s/\,/\,\| /gm; |
| $memstuff =~ s/Work\_mem/\| Work\_mem/gm; |
| } |
| |
| # $outi .= " | { " . join(" | " , $frst, $last) . " } "; |
| $outi .= " | { " . join(" | " , $slice, $frst, $last) . " } " . $memstuff; |
| |
| # wrapping with braces changes record organization to vertical |
| $outi = "{ " . $outi . " } "; |
| } |
| |
| |
| return $outi; |
| } |
| |
| |
| sub dotlabel |
| { |
| my $node = shift; |
| |
| # XXX XXX: olap fixup - don't label duplicate multi slice motion nodes |
| return |
| if (exists($node->{MultiSliceMotionDuplicate})); |
| |
| my $colortable = $glob_coltab{$glob_colorscheme}; |
| |
| my $color = scalar(@{$colortable}); |
| $color = $node->{slice} if (exists($node->{slice})); |
| $color =~ s/slice//; |
| |
| $color = ($color) % (scalar(@{$colortable})); |
| |
| # build list of node attributes |
| my @attrlist; |
| push @attrlist, "shape=record"; |
| # push @attrlist, "shape=polygon"; |
| # push @attrlist, "peripheries=2"; |
| |
| # push @attrlist, 'fontcolor=white'; |
| |
| push @attrlist, 'label="' . dotlabel_detail($node) .'"'; |
| push @attrlist, 'style=filled'; |
| # push @attrlist, 'style="filled,bold"'; |
| # push @attrlist, "color=" . $colortable->[$color]; |
| # push @attrlist, "fillcolor=" . $colortable->[$color]; |
| |
| if (exists($node->{color_rank})) # color by statistical ranking |
| { |
| my $edgecol = $glob_divcol{rdbu11}->[$node->{color_rank}]; |
| my $fillcol = $colortable->[$color]; |
| |
| if (defined($glob_statcolor)) |
| { |
| if ($glob_statcolor =~ m/^t$/i) |
| { |
| # show timing color only |
| $fillcol = $edgecol; |
| } |
| if ($glob_statcolor =~ m/^st/i) |
| { |
| # edge is slice color, fill is time stats |
| # invert the selection |
| ($edgecol, $fillcol) = ($fillcol, $edgecol); |
| } |
| } |
| |
| push @attrlist, 'style="filled,setlinewidth(6)"'; |
| push @attrlist, "color=\"" . $edgecol . '"'; |
| |
| push @attrlist, "fillcolor=\"" . $fillcol . '"'; |
| } |
| else |
| { |
| push @attrlist, "color=\"" . $colortable->[$color] . '"'; |
| push @attrlist, "fillcolor=\"" . $colortable->[$color] . '"'; |
| } |
| |
| if (exists($node->{crunchme})) |
| { |
| @attrlist = (); |
| |
| # push @attrlist, 'style=filled'; |
| push @attrlist, 'style=filled'; |
| push @attrlist, "color=\"" . $colortable->[$color] . '"'; |
| push @attrlist, "fillcolor=\"" . $colortable->[$color] . '"'; |
| # push @attrlist, "shape=circle"; |
| push @attrlist, "label=\"" . $node->{short} . '"'; |
| # push @attrlist, "fontsize=1"; |
| # push @attrlist, "height=0.01"; |
| # push @attrlist, "width=0.01"; |
| # push @attrlist, "height=0.12"; |
| # push @attrlist, "width=0.12"; |
| |
| print '"' . $node->{id} . '" [' . join(", ", @attrlist) . '];' . "\n" ; |
| } |
| else |
| { |
| print '"' . $node->{id} . '" [' . join(", ", @attrlist) . '];' . "\n" ; |
| } |
| |
| if (exists($node->{child})) |
| { |
| for my $kid (@{$node->{child}}) |
| { |
| dotlabel($kid); |
| } |
| |
| } |
| |
| } |
| |
| |
| sub makedotfile |
| { |
| my ($plantree, $time_list, $do_timeline, $plan_num, $parse_ctx, |
| $direction) = @_; |
| |
| # print "\n\ndigraph plan1 { ranksep=.75; size = \"7.5,7.5\";\n\n \n"; |
| print "\n\ndigraph plan$plan_num { \n"; |
| |
| # print "graph [bgcolor=black];\n edge [style=bold, color=white];\n"; |
| # print "graph [bgcolor=black];\n edge [style=dashed, color=white];\n"; |
| # print "graph [bgcolor=black];\n edge [style=dotted, color=white];\n"; |
| |
| if ($do_timeline && scalar(@{$time_list})) |
| { |
| print " ranksep=.75; size = \"7.5,7.5\";\n\n \n"; |
| print " {\n node [shape=plaintext, fontsize=16];\n"; |
| print "/* the time-line graph */\n"; |
| |
| print join(' -> ', @{$time_list} ), ";\n"; |
| print "}\n"; |
| |
| print "node [shape=box];\n"; |
| |
| while ( my ($kk, $vv) = each(%{$parse_ctx->{h_to_startoff}})) |
| { |
| print '{ rank = same; ' . $kk . '; ' . join("; ", @{$vv}) . "; }\n"; |
| } |
| |
| } |
| |
| print "rankdir=$direction;\n"; |
| |
| dotkid($plantree); |
| |
| dotlabel($plantree); |
| |
| print "\n}\n"; |
| |
| } |
| |
| |
| |
| exit(); |
