#!/opt/perl-5.14/bin/perl
use strict; use warnings;
use DBI; use IO::File; use Test::More; use Time::HiRes qw(gettimeofday tv_interval);
$| = 1;
our %instance = ();
main();
exit;
sub main {
    init();
    for my $nm (@{instances()}) {
        printf("-- instance %-20s    host %-9s   port %5s    db %s   status %s\n"
            , $instance{ $nm }->{ name }
            , $instance{ $nm }->{ host }
            , $instance{ $nm }->{ port }
            , $instance{ $nm }->{ db   }
            , $instance{ $nm }->{ up   }
        );
    }
#   my $re = test_cases1();
    my $re2 = test_cases2( 1, 2, 1 );
    my $re3 = test_cases2( 1, 3, 1 );
    my $re4 = test_cases2( 1, 3, 1 );
    my $re5 = test_cases2( 1, 4, 1 );
    my $re6 = test_cases2( 1, 5, 1 );
    my $re7 = test_cases2( 1, 6, 1 );
    my @re = ();
    push(@re, @$re2, @$re3, @$re4, @$re5, @$re6, @$re7);
  # print "-- ", scalar(@$re1), " cases\n";
  # print "-- ", scalar(@$re2), " cases\n";
  # print "-- ", scalar(@$re3), " cases\n";
    print "-- ", scalar(@re), " cases\n";
    for my $re (@re) { print $re, "\n"; }
    print "\n";
    for my $table ( "azjunk4", "azjunk5", "azjunk6", "azjunk7" )
    {
        for my $re (@re)
        {
            for my $nm (@{instances()})
            {
                if( $instance{ $nm }->{ up })
                {
                    my $dbh = $instance{ $nm }->{ dbh };
                    #if ($re eq $re[0])
                    #{
                    #    $dbh->do("set session enable_bitmapscan=0");
                    #    test($dbh, 'trgm_regex', $re[0], $table);
                    #    test($dbh, 'trgm_regex', $re[0], $table);
                    #    test($dbh, 'trgm_regex', $re[0], $table);
                    #    test($dbh, 'trgm_regex', $re[0], $table);
                    #}
                    #$dbh->do("set session enable_bitmapscan=1");
                    my $action = test($dbh, $nm, $re, $table); next if ($action eq "Seq Scan");  #  && $nm eq "HEAD");
                       $action = test($dbh, $nm, $re, $table); next if ($action eq "Seq Scan");  # twice seqscan is enough...
                       $action = test($dbh, $nm, $re, $table);
                       $action = test($dbh, $nm, $re, $table);
                    #$dbh->do("set session enable_bitmapscan=1"); # set back to normal...
                }
            }
            print "\n";
        }
    }
    print "done.\n";
}
sub test {
    my ($dbh, $name, $re, $table) = @_;
    my $arf        = $dbh->selectall_arrayref( "select current_setting('port'), current_setting('enable_bitmapscan')" );
    my $port       = $arf->[0][0];
    my $bitmapscan = $arf->[0][1];
    my $action     = '';
    my $sql = "explain analyze select txt from ${table} where txt ~ '${re}'";
#   print $sql, "\n";
    my $t0 = [gettimeofday]; my $sth = $dbh->prepare($sql) or die "die() prepare\n"; my $d0 = tv_interval($t0,[gettimeofday]);
    my $t1 = [gettimeofday]; my $rc  = $sth->execute()     or die "die() execute\n"; my $d1 = tv_interval($t1,[gettimeofday]);
    my $t2 = [gettimeofday];
    my $rows = -1;
    while (my $rrow = $sth->fetch)
    {
        if    ($rrow->[0] =~ /^Seq Scan.........*actual time=.* rows=([[:digit:]]+)/ ) { $action = 'Seq Scan';         $rows=$1; }
        elsif ($rrow->[0] =~ /^Bitmap Heap Scan.*actual time=.* rows=([[:digit:]]+)/ ) { $action = 'Bitmap Heap Scan'; $rows=$1; }
        if ($rrow->[0] =~ /^Total runtime: (.*)/)
        {
             print sprintf("%5d %-11s",$port, $name)
                    , "  $table  "
                    , sprintf("%-20s",$re)
                #   , sprintf("%3s", $bitmapscan), " "
                    , sprintf("%6d", $rows), "  "
                    , sprintf("%-16s", $action)
                    , sprintf("%13s", $1)
            ;
            $rows = -1;
        }
    }
    my $t3 = [gettimeofday];
    my $d2 = tv_interval($t2,$t3);
#   print " ", sprintf("%12.3f ms ( =%6.3f%12.3f%10.3f )", tv_interval($t0,$t3)*1000, $d0*1000, $d1*1000, $d2*1000), "  ", $sql, "\n";
    print " ", sprintf("%12.3f ms "                      , tv_interval($t0,$t3)*1000                              );
    print "  ", $sql, "\n";
    $action;
}
sub test_cases2 {
    my ($length1, $length2, $length3) = @_;
    my @re = ();
    my $source1 = 'xlmnqrstggret';
    my $source2 = 'aeiouycvwytrd';
    my $source3 = 'qrstgxlmnasdt';
    for my $c11 ( ($length1 > 1 ? "[" : "") .  substr($source1, 0, $length1) . ($length1 > 1 ? "]" : "") ) {
    for my $c21 ( ($length2 > 1 ? "[" : "") .  substr($source2, 0, $length2) . ($length2 > 1 ? "]" : "") ) {
    for my $c31 ( ($length3 > 1 ? "[" : "") .  substr($source3, 0, $length3) . ($length3 > 1 ? "]" : "") ) {
                             push @re, "${c11}${c21}${c31}";
                             push @re, "${c11}${c21}{1}${c31}";
                             push @re, "${c11}${c21}{1,1}${c31}";
                             push @re, "${c11}${c21}{,2}${c31}";
                             push @re, "${c11}${c21}{,10}${c31}";
        if ($length2 >= 2) { push @re, "${c11}${c21}{1,2}${c31}"; }
        if ($length2 >= 3) { push @re, "${c11}${c21}{1,3}${c31}"; }
        if ($length2 >= 4) { push @re, "${c11}${c21}{1,4}${c31}"; }
        if ($length2 >= 4) { push @re, "${c11}${c21}{2,4}${c31}"; }
        if ($length2 >= 4) { push @re, "${c11}${c21}{3,4}${c31}"; }
        if ($length2 >= 5) { push @re, "${c11}${c21}{1,5}${c31}"; }
        if ($length2 >= 5) { push @re, "${c11}${c21}{2,5}${c31}"; }
        if ($length2 >= 5) { push @re, "${c11}${c21}{4,5}${c31}"; }
#        if ($length2 >= 9) { push @re, "${c11}${c21}{1,9}${c31}"; }
    #    push @re, "${c11}${c21}+${c31}";
    }}};
    \@re
}
#sub test_cases1 {
#    my @re = ();
#    for my $c11 ("a", "m", "z") {
#    for my $c12 ("a", "m", "z") {
#    for my $c21 ("a", "m", "z") {
#    for my $c22 ("a", "m", "z") {
#    for my $c31 ("a", "m", "c") {
#    for my $c32 ("a", "m", "z") {
#        push @re, "[${c11}${c12}][${c21}${c22}][${c31}${c32}]";
#    }}}}}}
#    \@re
#}
sub init {
    my $host = "/tmp";
    my $db   = "testdb";
    for my $instance (@{ instances() })
    {
        my $port = instance_port($instance, "port");
        $instance{$instance}->{ name } = $instance;
        $instance{$instance}->{ host } = $host;
        $instance{$instance}->{ port } = $port;
        $instance{$instance}->{ db   } = $db;
        $instance{$instance}->{ up   } = 0;
        my $dbh; my $dsn = "dbi:Pg:host=$host;port=$port;db=$db;";
        eval { $dbh = DBI->connect($dsn, undef, undef, {RaiseError=>1, PrintError=>0, AutoCommit=>1,} ); };     # if ($@) { die "error connecting to instance $instance [$dsn]\n"; }
        if ($dbh)
        {
            $instance{$instance}->{ dbh } = $dbh;
            $instance{$instance}->{ up  } = 1;
        }
    }
}
sub instances {
      [qw/ HEAD trgm_regex6 trgm_regex7                                    /];
#     [qw/ HEAD trgm_regex                                                 /];
#     [qw/ HEAD trgm_regex trgm_regex_wchar2mb                             /];
#     [qw/ HEAD trgm_regex                 trgm_regex_max6 trgm_regex_max9 /];
#     [qw/ HEAD trgm_regex trgm_regex_max5 trgm_regex_max6 trgm_regex_max9 /];
#     [qw/      trgm_regex trgm_regex_max5 trgm_regex_max6 trgm_regex_max9 /];
}
sub instance_port {
    my ($instance, $guc) = @_;
#   my $root_dir    = '/var/data1';   # location on big server
    my $root_dir    = $ENV{HOME};     # location on modest desktop
    my $install_dir = $root_dir    . '/pg_stuff/pg_installations';
    my $conf_file   = $install_dir . '/pgsql.' . $instance . '/data/postgresql.conf';     if (! -e $conf_file) { die "no such file [$conf_file]\n"; }
    my $fh          = IO::File->new($conf_file, "r")        or die "-- Error: could not open file $conf_file\n";
    my $gucval;
    while (<$fh>)
    {
        # get default value for port (even if outcommented)
        if ( m,^[# ]*${guc}\s*=\s*([^#]+), ) 
        {
            $gucval = $1;
            $gucval =~ s{\s+$}{};
            return $gucval;
        }
    }
}