277 lines
7.0 KiB
Perl
277 lines
7.0 KiB
Perl
#!/usr/bin/perl
|
|
# Script for testing Bugzilla Search engine and comparing query results
|
|
|
|
use utf8;
|
|
use strict;
|
|
no warnings 'utf8';
|
|
|
|
use Cwd qw(abs_path);
|
|
use File::Basename qw(dirname);
|
|
use Encode;
|
|
use Time::HiRes qw(gettimeofday);
|
|
|
|
BEGIN {
|
|
my ($a) = abs_path($0) =~ /^(.*)$/;
|
|
chdir dirname($a);
|
|
}
|
|
|
|
use lib qw(..);
|
|
use Bugzilla;
|
|
use Bugzilla::CGI;
|
|
use Bugzilla::User;
|
|
use Bugzilla::Search;
|
|
|
|
*Bugzilla::Search::split_order_term = *split_order_term;
|
|
|
|
my $SLOW_QUERY = 2;
|
|
|
|
my $IN = 'queries.txt';
|
|
my $RES = '';
|
|
my $LOG = '';
|
|
my $OLDRES = '';
|
|
|
|
for my $i (0..$#ARGV)
|
|
{
|
|
local $_ = $ARGV[$i];
|
|
if ($_ eq '-h' || $_ eq '--help')
|
|
{
|
|
print STDERR
|
|
"Script for testing Bugzilla Search engine and comparing query results
|
|
USAGE: perl $0 [-i queries.txt] [-r result.txt] [-l log.txt] [-o old-results-to-compare.txt]
|
|
|
|
Input 'queries.txt' file contains tested queries, one per a line, in the following format:
|
|
| userid | name | query string
|
|
|
|
When run with '-o' option, this script compares query results and performance
|
|
to the ones written into 'old-results-to-compare.txt' from previous run.
|
|
|
|
Example usage:
|
|
1) Connect to Bugzilla database, run 'SELECT * FROM namedqueries' and save results into a file
|
|
2) Get a 'reference' Bugzilla version into different folder with same localconfig
|
|
3) Run: 'perl queries-unit.pl -l log-ref.txt -r res-ref.txt' inside the reference Bugzilla
|
|
4) Run: 'perl queries-unit.pl -l log-new.txt -r res-new.txt -o <path_to_ref_bugzilla>/t/res-ref.txt'
|
|
";
|
|
exit;
|
|
}
|
|
elsif ($_ eq '-i') { $IN = $ARGV[++$i]; }
|
|
elsif ($_ eq '-r') { $RES = $ARGV[++$i]; }
|
|
elsif ($_ eq '-l') { $LOG = $ARGV[++$i]; }
|
|
elsif ($_ eq '-o') { $OLDRES = $ARGV[++$i]; }
|
|
}
|
|
|
|
if (!$RES)
|
|
{
|
|
$RES = $IN;
|
|
$RES =~ s/\./-result\./so;
|
|
}
|
|
|
|
# Read queries
|
|
my $queries = [];
|
|
open FD, '<', $IN or die "Cannot open '$IN'";
|
|
while (<FD>)
|
|
{
|
|
Encode::_utf8_on($_);
|
|
if (/^[^\|]*\|\s*(\d+)\s*\|\s*(.*?)\s*\|\s*(\S+)/s)
|
|
{
|
|
push @$queries, {
|
|
userid => $1,
|
|
name => $2,
|
|
query => $3,
|
|
};
|
|
}
|
|
}
|
|
close FD;
|
|
|
|
my $logfd;
|
|
if ($LOG)
|
|
{
|
|
open $logfd, '>', $LOG or die "Cannot open log '$LOG'";
|
|
}
|
|
|
|
my $old;
|
|
if ($OLDRES)
|
|
{
|
|
# Read old results
|
|
$old = do $OLDRES;
|
|
die $@ if $@;
|
|
}
|
|
|
|
$SIG{INT} = \&finish;
|
|
|
|
$| = 1;
|
|
my $results = {};
|
|
my (@lq, $maxl);
|
|
my $l;
|
|
my $bad;
|
|
my $i = 0;
|
|
for my $q (@$queries)
|
|
{
|
|
my $key = $q->{userid}.':'.$q->{name};
|
|
my $user = Bugzilla::User->new({ id => $q->{userid} });
|
|
print("Invalid user $q->{userid}!\n"), next unless $user;
|
|
next if $user->disabledtext;
|
|
my $s = "Testing $q->{userid}'s $q->{name}... ";
|
|
$l = length $s;
|
|
# $maxl is streaming maximum over last 10 lengths
|
|
$maxl = $lq[1] || $l;
|
|
pop(@lq), pop(@lq) while @lq && $lq[$#lq] < $l;
|
|
shift(@lq), shift(@lq) if $lq[0] <= $i-10;
|
|
push @lq, $i, $l;
|
|
$i++;
|
|
print $s;
|
|
print $logfd $s if $logfd;
|
|
# Generate query
|
|
my $t_start = gettimeofday();
|
|
Encode::_utf8_off($q->{query});
|
|
my $params = Bugzilla::CGI->new($q->{query});
|
|
my $search = Bugzilla::Search->new(
|
|
params => $params,
|
|
fields => [ 'bug_id' ],
|
|
user => $user,
|
|
order => make_order($params->param('order')),
|
|
);
|
|
my $sql = $search->getSQL();
|
|
$sql =~ s/^\s*SELECT/SELECT SQL_NO_CACHE/ if Bugzilla->dbh->isa('Bugzilla::DB::Mysql');
|
|
$q->{sql} = $sql;
|
|
my $result;
|
|
# Execute query
|
|
eval { $result = Bugzilla->dbh->selectcol_arrayref($sql) };
|
|
if ($@)
|
|
{
|
|
$q->{error} = $@;
|
|
$s = "Query error: $@\n";
|
|
print $s;
|
|
print $logfd $s if $logfd;
|
|
}
|
|
else
|
|
{
|
|
my $t_query = gettimeofday();
|
|
# Save results
|
|
$q->{result} = join(',', @$result);
|
|
$q->{time} = $t_query-$t_start;
|
|
$s = sprintf("%.2f sec, ", $q->{time}).@$result." bugs\n";
|
|
# Check results
|
|
$bad = 0;
|
|
if ($q->{time} > $SLOW_QUERY)
|
|
{
|
|
$s = "SLOW $s";
|
|
$bad = 'SLOW';
|
|
}
|
|
if ($old && $old->{$key})
|
|
{
|
|
if ($old->{$key}->{result} ne $q->{result})
|
|
{
|
|
if (join(',', sort split ',', $old->{$key}->{result}) ne
|
|
join(',', sort split ',', $q->{result}))
|
|
{
|
|
$bad = 'INVALID';
|
|
$s = "[!] INVALID [!] $s";
|
|
}
|
|
else
|
|
{
|
|
$bad = 'INVALID ORDER';
|
|
$s = "[!] INVALID ORDER [!] $s";
|
|
}
|
|
}
|
|
elsif ($q->{time} > $old->{$key}->{time}/0.8)
|
|
{
|
|
$bad = 'WORSE';
|
|
$s = sprintf("WORSE(by %.2f sec) ", $q->{time} - $old->{$key}->{time}).$s;
|
|
}
|
|
elsif ($old->{$key}->{time} > 0.1 && $q->{time}/$old->{$key}->{time} < 0.8)
|
|
{
|
|
$s = sprintf("BETTER(by %.2f sec) ", $old->{$key}->{time} - $q->{time}).$s;
|
|
}
|
|
}
|
|
$s = (' ' x ($maxl-$l)).$s;
|
|
if ($bad)
|
|
{
|
|
my $sql = $q->{sql};
|
|
$sql =~ s/^/ /gmo;
|
|
$s .= "$sql\n";
|
|
$s .= "$bad | $q->{userid} | $q->{name} | $q->{query}\n";
|
|
}
|
|
print $s;
|
|
print $logfd $s if $logfd;
|
|
}
|
|
$results->{$key} = $q;
|
|
}
|
|
|
|
finish();
|
|
|
|
sub dumper_simple
|
|
{
|
|
my ($h, $l) = @_;
|
|
$l ||= 0;
|
|
if (ref $h && $h =~ /ARRAY/)
|
|
{
|
|
my $s = "[\n";
|
|
for (@$h)
|
|
{
|
|
$s .= (' ' x ($l+1)).dumper_simple($_, $l+1).",\n";
|
|
}
|
|
$h = $s.(' ' x $l).']';
|
|
}
|
|
elsif (ref $h && $h =~ /HASH/)
|
|
{
|
|
my $s = "{\n";
|
|
for my $k (keys %$h)
|
|
{
|
|
$k =~ s/([\'\\])/\\$1/gso;
|
|
$s .= (' ' x ($l+1))."'$k' => ".dumper_simple($h->{$k}, $l+1).",\n";
|
|
}
|
|
$h = $s.(' ' x $l).'}';
|
|
}
|
|
else
|
|
{
|
|
$h = "$h";
|
|
$h =~ s/([\'\\])/\\$1/gso;
|
|
$h = "'$h'";
|
|
}
|
|
return $h;
|
|
}
|
|
|
|
sub finish
|
|
{
|
|
close $logfd if $logfd;
|
|
print "Terminating and saving results into '$RES'\n";
|
|
open FD, '>', $RES or die "Cannot write into '$RES'";
|
|
print FD dumper_simple($results);
|
|
close FD;
|
|
exit;
|
|
}
|
|
|
|
# Splits out "asc|desc" from a sort order item.
|
|
sub split_order_term
|
|
{
|
|
my $fragment = shift;
|
|
my ($col, $dir) = split /\s+/, $fragment, 2;
|
|
$col = lc $col;
|
|
$dir = uc $dir;
|
|
$dir = '' if $dir ne 'DESC' && $dir ne 'ASC';
|
|
return wantarray ? ($col, $dir) : $col;
|
|
}
|
|
|
|
sub make_order
|
|
{
|
|
my ($order) = @_;
|
|
my $old_orders = {
|
|
'' => 'bug_status,priority,assigned_to,bug_id', # Default
|
|
'bug number' => 'bug_id',
|
|
'importance' => 'priority,bug_severity,bug_id',
|
|
'assignee' => 'assigned_to,bug_status,priority,bug_id',
|
|
'last changed' => 'delta_ts,bug_status,priority,assigned_to,bug_id',
|
|
};
|
|
$order = '' if $order =~ /reuse same/is;
|
|
$order = $old_orders->{lc $order} || $order || $old_orders->{''};
|
|
$order .= ',bug_id' if $order !~ /bug_id/;
|
|
$order = [ split /\s*,\s*/, $order ];
|
|
for (@$order)
|
|
{
|
|
my ($c, $d) = split_order_term($_);
|
|
$c = translate_old_column($c);
|
|
$_ = $c.' '.$d;
|
|
}
|
|
return $order;
|
|
}
|