Scan all plans in db to find interesting ones

This is so that I will find things to work on for next improvements in the site.
2026-06-19 22:15:11 +02:00 · 2022-02-04 13:17:57 +01:00
parent 0ae60772d9
commit 5fd2f83e2e
2 changed files with 167 additions and 0 deletions
@@ -0,0 +1,21 @@
+# This file is used by cpanm.
+# To install dependencies, run >> cpanm --local-lib ~/perl5 --installdeps . <<, or something similar, depending on your setup.
+#
+# More details:
+# https://metacpan.org/pod/cpanfile
+# https://metacpan.org/pod/cpanm
+
+requires 'Carp';
+requires 'Config';
+requires 'DBD::Pg';
+requires 'DBI';
+requires 'Data::Dumper';
+requires 'File::Temp';
+requires 'List::Util';
+requires 'Parallel::ForkManager';
+requires 'Pg::Explain';
+requires 'Sys::Info';
+requires 'Unicode::Collate';
+requires 'Unicode::Normalize';
+
+# vim: set ft=perl:
@@ -0,0 +1,146 @@
+#!/usr/bin/env perl
+
+# UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
+use v5.14;
+use strict;
+use warnings;
+use warnings qw( FATAL utf8 );
+use utf8;
+use open qw( :std :utf8 );
+use Unicode::Normalize qw( NFC );
+use Unicode::Collate;
+use Encode qw( decode );
+
+if ( grep /\P{ASCII}/ => @ARGV ) {
+    @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV;
+}
+
+# If there is __DATA__,then uncomment next line:
+# binmode( DATA, ':encoding(UTF-8)' );
+# UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
+
+# Useful common code
+use autodie;
+use Carp qw( carp croak confess cluck );
+use English qw( -no_match_vars );
+use Data::Dumper qw( Dumper );
+
+# give a full stack dump on any untrapped exceptions
+local $SIG{ __DIE__ } = sub {
+    confess "Uncaught exception: @_" unless $^S;
+};
+
+# now promote run-time warnings into stackdumped exceptions
+#   *unless* we're in an try block, in which
+#   case just generate a clucking stackdump instead
+local $SIG{ __WARN__ } = sub {
+    if   ( $^S ) { cluck "Trapped warning: @_" }
+    else         { confess "Deadly warning: @_" }
+};
+
+# Useful common code
+
+use DBI;
+use Parallel::ForkManager;
+use List::Util qw( any );
+use Sys::Info;
+use Pg::Explain;
+use File::Temp qw( tempdir );
+
+my $partitions = get_list_of_partitions();
+my $cpus       = Sys::Info->new->device( 'CPU' )->count;
+my $output     = tempdir( 'interesting-explains.XXXXXX', TMPDIR => 1 );
+printf "Processing %d partitions in %d workers, output goes to %s\n", scalar @{ $partitions }, $cpus, $output;
+
+my $pm = Parallel::ForkManager->new( $cpus );
+
+PARTITION:
+for my $partno ( 0 .. $#{ $partitions } ) {
+    my $part = $partitions->[ $partno ];
+    $pm->start and next PARTITION;
+    printf "Starting partition #%d\n", 1 + $partno;
+
+    my $dbh = get_dbh();
+
+    my $seen        = 0;
+    my $errors      = 0;
+    my $interesting = 0;
+
+    my $query = sprintf "select id, plan FROM %s WHERE is_public and NOT is_deleted and NOT is_anonymized and plan ~ 'actual time=[0-9]'", $part;
+    $dbh->do( "DECLARE csr CURSOR FOR $query" );
+    while ( 1 ) {
+        my $rows = $dbh->selectall_arrayref( 'FETCH 100 FROM csr', { 'Slice' => {} } );
+        last if 0 == scalar @{ $rows };
+        for my $row ( @{ $rows } ) {
+            $seen++;
+            my $explain;
+            eval {
+                $explain = Pg::Explain->new( 'source' => $row->{ 'plan' } );
+                $explain->parse_source();
+            };
+            if ( $EVAL_ERROR ) {
+                $errors++;
+                next;
+            }
+            next unless $explain->top_node;
+            next unless is_plan_interesting( $explain );
+            $interesting++;
+
+            my $output_path = sprintf '%s/%s.plan', $output, $row->{ 'id' };
+            open my $fh, '>', $output_path;
+            print $fh $row->{ 'plan' };
+            close $fh;
+        }
+    }
+
+    $dbh->rollback();
+    $dbh->disconnect();
+    printf "Partition %d done. %d plans scanned, %d errored out, %d interesting saved.\n", 1 + $partno, $seen, $errors, $interesting;
+    $pm->finish;
+}
+$pm->wait_all_children;
+
+printf "All done, output in %s\n", $output;
+
+exit;
+
+sub is_plan_interesting {
+    my $plan = shift;
+    for my $node ( $plan->top_node, $plan->top_node->all_recursive_subnodes ) {
+        next unless $node->total_rows;
+        next unless $node->total_rows > 200;
+        next unless $node->total_rows_removed;
+        next unless $node->total_rows_removed > 9 * $node->total_rows;
+        next unless $node->extra_info;
+        next unless any { /^Filter:/ } @{ $node->extra_info };
+        return 1;
+    }
+    return;
+}
+
+sub get_dbh {
+    my $dsn = sprintf 'dbi:Pg:dbname=%s', $ENV{ 'PGDATABASE' } || 'depesz_explain';
+    $dsn .= sprintf ';host=%s', $ENV{ 'PGHOST' } if $ENV{ 'PGHOST' };
+    $dsn .= sprintf ';port=%s', $ENV{ 'PGPORT' } if $ENV{ 'PGPORT' };
+
+    return DBI->connect( $dsn, undef, undef, { 'AutoCommit' => 0, 'PrintError' => 1, 'RaiseError' => 1 } );
+}
+
+sub get_list_of_partitions {
+    my $dbh   = get_dbh();
+    my $parts = $dbh->selectcol_arrayref( "
+        SELECT
+            c.oid::regclass
+        FROM
+            pg_catalog.pg_class c
+            JOIN pg_catalog.pg_inherits i ON c.oid = i.inhrelid
+        WHERE
+            i.inhparent = 'public.plans'::regclass
+            AND c.relkind = 'r'
+        ORDER BY
+            c.relpages DESC
+    " );
+    $dbh->rollback();
+    $dbh->disconnect();
+    return $parts;
+}