trgm_regex_test.pl
application/x-perl
Filename: trgm_regex_test.pl
Type: application/x-perl
Part: 1
#!/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;
}
}
}