| #!/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 Config; |
| use strict; |
| use warnings; |
| |
| =head1 NAME |
| |
| B<gptorment.pl> - subject database to infernal torment |
| |
| =head1 SYNOPSIS |
| |
| B<gptorment.pl> [options] |
| |
| Options: |
| |
| -help brief help message |
| -man full documentation |
| -connect psql connect parameters |
| -sqlfile the test file |
| -id id of parent (DO NOT SET) |
| -parallel degree of parallelism/concurrency |
| -iter number of testing iterations |
| -timelimit time duration for time-limited testing |
| -debug debug flag (show test plan, do not execute) |
| -tmpdir temporary directory (DO NOT SET) |
| -grace_period time to wait before killing child test processes |
| |
| =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<-connect> |
| |
| psql connect string, e.g: |
| |
| -connect '-p 11000 -d template1' |
| |
| =item B<-sqlfile> |
| |
| A sql file to execute. |
| |
| =item B<-id> |
| |
| The ID code for the parent of the current test process. DO NOT SET. |
| |
| =item B<-parallel> |
| |
| The degree of parallelism of testing. Spawn this many concurrent |
| child test processes. Degree=1 if not set. |
| |
| =item B<-iter> |
| |
| The number of test iterations (1 by default). Note that if only |
| iter is set and not timelimit, then gptorment has no way to detect |
| test failures like infinite loops or hangs. |
| |
| =item B<-timelimit> |
| |
| For timed testing, the amount of time spent repeating the test. |
| If iter is set, then run the test for (iter*timelimit) time. |
| If no units are specified, the timelimit is in seconds. Timelimit |
| accepts mixed time specifications like -tl="1 min 14 seconds" or |
| even -tl="2+2 min - 14 seconds" |
| |
| Legal time periods are seconds, minutes, hours, days, weeks, years |
| (but not months!). gptorment simply uses the first letter of the |
| unit to determine the period. |
| |
| =item B<-debug> |
| |
| If specified, gptorment prints the basic test plan, but does not |
| execute it. |
| |
| =item B<-tmpdir> |
| |
| The temporary directory containing all test output (DO NOT SET). |
| |
| =item B<-grace_period> |
| |
| If a timelimit is specified, the grace period is the amount of |
| time gptorment waits after the timelimit is exceeded before trying |
| to B<kill -9> the child processes. A grace period can be negative, |
| which will cause gptorment to kill the children prematurely. Note |
| that if you use a negative number, you must quote the expression |
| e.g. -grace='-10 sec' to prevent gptorment from confusing the |
| leading minus with a command argument. |
| |
| =back |
| |
| =head1 DESCRIPTION |
| |
| gptorment.pl is a stress test framework. |
| Substitute the correct "connect string" for your postgres database. |
| |
| gptorment.pl repeated executes a test plan against the database for a |
| number of iterations or for a specified amount of time, using a |
| specified degree of concurrency. It is designed for batch or |
| interactive use. Because this type of testing can result in serious |
| failure, deadlocks, or other system resource issues, gptorment has a |
| simple but robust strategy to manage child processes. Rather than |
| wait for child processes, gptorment detaches them, but it marks a |
| unique id in the process argument list. gptorment uses "ps" to |
| monitor the state of the child processes, and it can clean up "stuck" |
| processes with kill -9. |
| |
| When gptorment is invoked, it creates a uniquely-named temporary |
| directory to hold test output. All the child processes write their |
| output to files in this directory. |
| |
| gptorment does not create or startup a database. |
| |
| -head1 TODO |
| |
| invoke perl scripts |
| init, cleanup |
| |
| |
| =head1 AUTHORS |
| |
| Apache HAWQ |
| |
| Address bug reports and comments to: dev@hawq..apache.org |
| |
| =cut |
| |
| my $glob_id = ""; |
| |
| my %GH; # GLOBAL HASH of all arguments |
| |
| sub gettimelimit |
| { |
| my $tlim = shift; |
| |
| return undef |
| unless (defined($tlim)); |
| |
| # time limit in seconds or other units (but not "1hr10min") |
| # time [space] [timeunit]{lookahead} |
| unless ($tlim =~ m/^\s*(\+|\-|\.|\()?\d+/) |
| { |
| return undef; |
| } |
| |
| $tlim =~ s/\s+//gm; # no spaces |
| |
| # XXX XXX: month |
| |
| $tlim =~ s/([a-zA-Z])([a-zA-Z])*/$1/gm; |
| |
| # print "tlim: $tlim\n"; |
| |
| $tlim = lc($tlim); |
| |
| my @foo = split(/([a-z])/, $tlim); |
| |
| $tlim = 0; |
| |
| my $tempnum; |
| |
| for my $vv (@foo) |
| { |
| next |
| unless (length($vv)); |
| |
| if ($vv !~ /^[a-z]$/) |
| { |
| my $estr = '$tempnum = 0 + (' . $vv . ');'; |
| |
| # print "e:",$estr, "\n"; |
| |
| eval $estr; |
| if ($@) |
| { |
| warn "invalid numeric format \'$vv\' in time specification\n"; |
| return undef; |
| } |
| } |
| else |
| { |
| my $min = 60; |
| my $hr = $min * 60; |
| my $day = $hr * 24; |
| my $wk = $day * 7; |
| my $mon = $day * 30; |
| my $yr = $day * 365; |
| |
| if ($vv =~ m/s/) |
| { |
| $tlim += ($tempnum) |
| } |
| elsif ($vv =~ m/m/) |
| { |
| $tlim += ($tempnum*$min) |
| } |
| elsif ($vv =~ m/h/) |
| { |
| $tlim += ($tempnum*$hr) |
| } |
| elsif ($vv =~ m/d/) |
| { |
| $tlim += ($tempnum*$day) |
| } |
| elsif ($vv =~ m/w/) |
| { |
| $tlim += ($tempnum*$wk) |
| } |
| # XXX XXX: month |
| elsif ($vv =~ m/y/) |
| { |
| $tlim += ($tempnum*$yr) |
| } |
| else |
| { |
| warn "unknown time period spec \'$vv\'"; |
| return undef; |
| } |
| $tempnum = 0; |
| |
| } |
| |
| } |
| |
| $tlim += $tempnum; |
| |
| # print join(":", @foo), "\n"; |
| # print "time limit: $tlim \n"; |
| |
| return $tlim; |
| |
| } # end gettimelimit |
| |
| sub I_am_interactive |
| { |
| return -t STDIN ; |
| } |
| |
| sub gettmpfile |
| { |
| |
| } # end gettmpfile |
| |
| sub gettmpdir |
| { |
| use File::Temp qw/ tempfile tempdir /; |
| |
| my $id = shift; |
| |
| # try to remove the leading date/time string from the id (to save |
| # some space), since it will be implicit in the directory creation |
| # time |
| my @foo = split(/\./, $id, 2); |
| |
| if (2 == scalar(@foo)) |
| { |
| shift @foo; |
| $id = pop(@foo); |
| } |
| |
| # replace dots with underscores |
| $id =~ s/\./\_/gm; |
| |
| my $template = "gptorment_" . $id . "_XXXXXX"; |
| |
| my $tempdir = tempdir ( $template, TMPDIR => 1, SUFFIX => '.dir' ); |
| |
| return $tempdir; |
| } # end gettmpdir |
| |
| BEGIN { |
| my $man = 0; |
| my $help = 0; |
| my $table; |
| my $conn; |
| my $paral; |
| my $uid; |
| my $sqlfile; |
| my $iter; |
| my $tlim; |
| my $dbg; |
| my $tmpdir; |
| my $grace; |
| |
| GetOptions( |
| 'help|?' => \$help, man => \$man, |
| "connect=s" => \$conn, |
| "id:s" => \$uid, |
| "parallel:i" => \$paral, |
| "sqlfile:s" => \$sqlfile, |
| "iter:i" => \$iter, |
| "tlim|timelimit:s" => \$tlim, |
| "dbg|debug:s" => \$dbg, |
| "tmpdir|tempdir:s" => \$tmpdir, |
| "grace_period|grace_time|graceperiod|gracetime:s" => \$grace, |
| ) |
| or pod2usage(2); |
| |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1) if $help; |
| pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man; |
| |
| $GH{connect} = $conn; |
| |
| $GH{connect} = '-p 11000 -d template1' |
| unless (defined($GH{connect})); |
| |
| { # check for bad connection |
| my $badconnect = 0; |
| my $psql_str = "psql "; |
| |
| $psql_str .= $GH{connect} |
| if (defined($GH{connect})); |
| |
| $psql_str .= " -c \"select version()\" "; |
| |
| my $tabdef = `( $psql_str ) 2>&1`; |
| |
| # should say something like: |
| # |
| # version |
| # -------------- |
| # PostgreSQL 8.2.5 (Greenplum Database... |
| # |
| my @l3 = split(/\n/, $tabdef, 3); |
| |
| if (3 != scalar(@l3)) |
| { |
| $badconnect = 1; |
| goto l_badconnect; |
| } |
| |
| my $hd1 = shift @l3; |
| |
| if ($hd1 !~ m/^\s*version\s*$/) |
| { |
| $badconnect = 1; |
| goto l_badconnect; |
| } |
| my $hd2 = shift @l3; |
| |
| if ($hd2 !~ m/^\s*(\-)+\s*$/) |
| { |
| $badconnect = 1; |
| goto l_badconnect; |
| } |
| |
| l_badconnect: |
| |
| if ($badconnect) |
| { |
| $glob_id = "connect failed using \'" . $GH{connect} . "\'"; |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| } |
| |
| $paral = 1 |
| unless (defined($paral)); |
| |
| unless (defined($uid)) |
| { |
| |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
| localtime(time); |
| |
| $year += 1900; |
| $mon++; |
| |
| $uid = sprintf("%04d%02d%02d%02d%02d%02d", |
| $year,$mon, $mday, $hour, $min ,$sec); |
| } |
| |
| $uid .= "." . $$; |
| |
| $iter = 1 |
| unless (defined($iter)); |
| |
| unless (defined($sqlfile)) |
| { |
| $glob_id = "no sql file"; |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| |
| unless (-e $sqlfile) |
| { |
| $glob_id = "sql file \'" . $sqlfile . "\' does not exist"; |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| |
| if (defined($tlim)) |
| { |
| my $orig_tlim = $tlim; |
| |
| $tlim = gettimelimit($tlim); |
| |
| unless (defined($tlim)) |
| { |
| $glob_id = "invalid timelimit specification: $orig_tlim"; |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| if ($tlim <= 0) |
| { |
| warn "invalid negative time $tlim seconds"; |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| } |
| |
| unless (defined($tmpdir)) |
| { |
| $tmpdir = gettmpdir($uid); |
| } |
| |
| if (defined($grace)) |
| { |
| my $orig_tlim = $grace; |
| |
| $grace = gettimelimit($grace); |
| |
| unless (defined($grace)) |
| { |
| $glob_id = "invalid grace_limit specification: $orig_tlim"; |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1); |
| } |
| # NOTE: allow negative grace period |
| } |
| else |
| { |
| $grace = 10; |
| } |
| |
| |
| $GH{uid} = $uid; |
| $GH{parallel} = $paral; |
| $GH{iter} = $iter; |
| $GH{sqlfile} = $sqlfile; |
| $GH{tlim} = $tlim; |
| $GH{debug} = $dbg; |
| $GH{tmpdir} = $tmpdir; |
| $GH{grace} = $grace; |
| |
| # print "loading...\n" ; |
| } |
| |
| # convert a postgresql psql formatted table into an array of hashes |
| sub tablelizer |
| { |
| my $ini = shift; |
| |
| # first, split into separate lines, the find all the column headings |
| |
| my @lines = split(/\n/, $ini); |
| |
| return undef |
| unless (scalar(@lines)); |
| |
| my $line1 = shift @lines; |
| |
| # look for <space>|<space> |
| my @colheads = split(/\s+\|\s+/, $line1); |
| |
| # fixup first, last column head (remove leading,trailing spaces) |
| |
| $colheads[0] =~ s/^\s+//; |
| $colheads[0] =~ s/\s+$//; |
| $colheads[-1] =~ s/^\s+//; |
| $colheads[-1] =~ s/\s+$//; |
| |
| return undef |
| unless (scalar(@lines)); |
| |
| shift @lines; # skip dashed separator |
| |
| my @rows; |
| |
| for my $lin (@lines) |
| { |
| my @cols = split(/\|/, $lin, scalar(@colheads)); |
| last |
| unless (scalar(@cols) == scalar(@colheads)); |
| |
| my $rowh = {}; |
| |
| for my $colhd (@colheads) |
| { |
| my $rawcol = shift @cols; |
| |
| $rawcol =~ s/^\s+//; |
| $rawcol =~ s/\s+$//; |
| |
| $rowh->{$colhd} = $rawcol; |
| } |
| push @rows, $rowh; |
| } |
| |
| return \@rows; |
| } |
| |
| sub do_ps_pids |
| { |
| my $uid = shift; |
| |
| my $pidlist = []; |
| my $pidh = {}; |
| |
| if ($Config{'osname'} =~ m/solaris|sunos/i) |
| { |
| # MPP-10643: fix truncated command args on solaris |
| my $cmd = '/usr/ucb/ps -auxww | grep -v grep | grep gptorment | grep ' . $uid; |
| |
| my $psout = `$cmd`; |
| |
| my @lines = split(/\n/, $psout); |
| |
| for my $lin (@lines) |
| { |
| my @foo = split(/\s+/, $lin, 3); |
| |
| next |
| unless (3 == scalar(@foo)); |
| |
| shift @foo; |
| |
| my $pid = shift @foo; |
| |
| push @{$pidlist}, $pid; |
| |
| $pidh->{$pid} = 1; |
| |
| } |
| } |
| else # linux or osx |
| { |
| my $cmd = 'ps auxww | grep -v grep | grep gptorment | grep ' . $uid; |
| |
| my $psout = `$cmd`; |
| |
| my @lines = split(/\n/, $psout); |
| |
| for my $lin (@lines) |
| { |
| my @foo = split(/\s+/, $lin, 3); |
| |
| next |
| unless (3 == scalar(@foo)); |
| |
| shift @foo; |
| |
| my $pid = shift @foo; |
| |
| push @{$pidlist}, $pid; |
| |
| $pidh->{$pid} = 1; |
| |
| } |
| } |
| return ($pidh, $pidlist); |
| } # end do_ps_pids |
| |
| |
| sub init_monitor |
| { |
| my ($uid, $iter, $tlim, $paral) = @_; |
| |
| my $mon_stat = {}; |
| |
| $mon_stat->{uid} = $uid; |
| $mon_stat->{iter} = $iter; |
| $mon_stat->{tlim} = $tlim; |
| $mon_stat->{paral} = $paral; |
| |
| my ($pidh, $pidlist) = do_ps_pids($uid); |
| |
| $mon_stat->{orig_pidlist} = $pidlist; |
| $mon_stat->{curr_pidlist} = []; |
| push @{$mon_stat->{curr_pidlist}}, @{$pidlist}; |
| $mon_stat->{pidh} = $pidh; |
| |
| if ($paral != scalar(@{$pidlist})) |
| { |
| $mon_stat->{msg} = "WARNING: found " . scalar(@{$pidlist}) . |
| " processes, expected " . $paral . ".\n"; |
| } |
| else |
| { |
| $mon_stat->{msg} = "Found " . $paral . " processes.\n" |
| } |
| |
| # print Data::Dumper->Dump([$mon_stat]); |
| |
| return $mon_stat; |
| |
| } |
| |
| sub do_monitor |
| { |
| my ($mon_stat, $tim, $test_fh) = @_; |
| |
| # print $$, ": ", Data::Dumper->Dump([$mon_stat]), "\nGH: ", |
| # Data::Dumper->Dump([%GH]), "\n" |
| # unless (exists($mon_stat->{uid}) |
| # && exists($mon_stat->{curr_pidlist})); |
| |
| my ($pidh, $pidlist) = do_ps_pids($mon_stat->{uid}); |
| |
| if (exists($mon_stat->{msg})) |
| { |
| print $mon_stat->{msg}; |
| |
| print $test_fh $mon_stat->{msg} if (defined($test_fh)); |
| |
| delete $mon_stat->{msg}; |
| } |
| |
| my $pcount = scalar(@{$pidlist}); |
| my $old_pcount = scalar(@{$mon_stat->{curr_pidlist}}); |
| |
| my $status_change = 1; |
| my $mmm; |
| if ($pcount < $old_pcount) |
| { |
| $mmm = time() . ": " . ($old_pcount - $pcount) . |
| " processes died, $pcount remaining\n"; |
| } |
| elsif ($pcount > $old_pcount) |
| { |
| $mmm = time() . ": " . ($pcount - $old_pcount) . |
| " processes BORN, $pcount now remaining\n"; |
| |
| } |
| else |
| { |
| $mmm = time() . ": " . $pcount . " processes still remaining\n"; |
| $status_change = 0; |
| } |
| |
| print $mmm; |
| |
| print $test_fh $mmm if (defined($test_fh) && $status_change); |
| |
| $mon_stat->{curr_pidlist} = $pidlist; |
| $mon_stat->{pidh} = $pidh; |
| |
| sleep ($tim) |
| if ($pcount); |
| |
| return $pcount; |
| } |
| |
| |
| sub do_kill_kill |
| { |
| my ($uid, $iter, $tlim, $paral, $test_fh, $mon_stat, $maxtime) = @_; |
| |
| # kill if necessary |
| |
| do_monitor($mon_stat, 0, $test_fh); |
| |
| my $pcount = scalar(@{$mon_stat->{curr_pidlist}}); |
| |
| my $mmm = time() . ": $pcount processes remain at test end\n"; |
| |
| print $mmm; |
| print $test_fh $mmm if (defined($test_fh)); |
| |
| for my $pid (@{$mon_stat->{curr_pidlist}}) |
| { |
| print "killing $pid\n"; |
| system ("kill -9 $pid"); |
| } |
| |
| if (!defined($maxtime)) |
| { |
| $mmm = "test ended prematurely (no time limit specified)"; |
| |
| } |
| else |
| { |
| my $time_diff = $maxtime - time(); |
| |
| if ($GH{grace} > 0) |
| { |
| if ($time_diff <= $GH{grace}) |
| { |
| $mmm = "test ended on time (grace period $GH{grace})\n"; |
| } |
| else |
| { |
| $mmm = "test ended $time_diff seconds prematurely\n"; |
| } |
| } |
| else |
| { |
| my $grt = (-1 * $GH{grace}); |
| |
| if ($time_diff <= $grt) |
| { |
| $mmm = |
| "test ended on time (negative grace period $GH{grace})\n"; |
| } |
| else |
| { |
| $mmm = "test ended " . ($time_diff - $grt) . |
| " seconds prematurely\n"; |
| } |
| } |
| } |
| |
| print $mmm; |
| print $test_fh $mmm if (defined($test_fh)); |
| |
| } # end do_kill_kill |
| |
| sub do_kill |
| { |
| my ($uid, $iter, $tlim, $paral, $test_fh) = @_; |
| |
| my $mon_stat = init_monitor($uid, $iter, $tlim, $paral); |
| $GH{mon_stat} = $mon_stat; |
| |
| my $maxtime = time() + ($GH{iter} * $GH{tlim}) + $GH{grace}; |
| $GH{maxtime} = $maxtime; |
| |
| while (do_monitor($mon_stat, 10, $test_fh) && (time() < $maxtime)) |
| { |
| $GH{mon_stat} = $mon_stat; |
| } |
| |
| do_kill_kill($uid, $iter, $tlim, $paral, $test_fh, $mon_stat, $maxtime); |
| } # end do_kill |
| |
| # cntrl c handler |
| sub do_handle_interrupt |
| { |
| my $test_fh = $GH{test_fh}; |
| |
| my $mmm = "\n" . time() . ": Test interrupted!\n"; |
| |
| print $mmm; |
| print $test_fh $mmm |
| if (defined($test_fh)); |
| |
| # print Data::Dumper->Dump([%GH]), "\n"; |
| |
| if (defined($GH{mon_stat}) && defined($GH{parallel}) |
| && $GH{parallel} > 1) |
| { |
| $mmm = "\n" . time() . ": Attempting to clean up child processes\n"; |
| print $mmm; |
| print $test_fh $mmm |
| if (defined($test_fh)); |
| |
| do_kill_kill($GH{uid}, $GH{iter}, $GH{tlim}, $GH{parallel}, |
| $GH{test_fh}, $GH{mon_stat}, $GH{maxtime}); |
| } |
| else |
| { |
| $mmm = "cleaning up..."; |
| print $mmm; |
| print $test_fh $mmm |
| if (defined($test_fh)); |
| |
| } |
| |
| close $test_fh |
| if (defined($test_fh)); |
| |
| exit; |
| } |
| |
| sub do_sql |
| { |
| my $psql_str = "psql "; |
| |
| $psql_str .= $GH{connect} |
| if (defined($GH{connect})); |
| |
| # $psql_str .= " -c \'\\d $glob_tab \'"; |
| # $psql_str .= " -c \'select * from gp_configuration \'"; |
| |
| $psql_str .= " -a -e -f $GH{sqlfile}"; |
| |
| # print $psql_str, "\n"; |
| |
| my $tstout = "gpt_" . $GH{uid}; |
| |
| $tstout =~ s/\./\_/gm; |
| |
| $tstout .= ".out"; |
| |
| $tstout = File::Spec->catfile($GH{tmpdir}, $tstout); |
| |
| my $tstfh; |
| |
| open ($tstfh, ">$tstout" ) or die "can't open $tstout: $!"; |
| |
| $GH{test_fh} = $tstfh; |
| |
| if (($GH{parallel} == 1) && (!defined($GH{debug}))) |
| { |
| my $start_time = time(); |
| my $end_time; |
| $end_time = $start_time + $GH{tlim} |
| if (defined($GH{tlim})); |
| |
| # print "sql tlim: $GH{tlim}\n" |
| # if (defined($GH{tlim})); |
| |
| my $realSTDOUT; |
| |
| open $realSTDOUT, ">&STDOUT" or die "Can't dup STDOUT: $!"; |
| |
| for my $ii (1..$GH{iter}) |
| { |
| my $filnam; |
| |
| $filnam = "sql_" . $GH{uid} . "_" . $ii; |
| |
| $filnam =~ s/\./\_/gm; |
| |
| $filnam .= ".out"; |
| |
| my $tmpnam = File::Spec->catfile($GH{tmpdir}, $filnam); |
| |
| close STDOUT; |
| open (STDOUT, ">$tmpnam" ) or die "can't open STDOUT: $!"; |
| |
| select STDOUT; $| = 1; # make unbuffered |
| |
| my $tl_iter = 0; |
| |
| l_timeloop: |
| |
| my $tabdef = `( $psql_str ) 2>&1`; |
| |
| print $tabdef; |
| print $tstfh $tabdef; |
| |
| if (defined($end_time)) |
| { |
| if (time() < $end_time) |
| { |
| $tl_iter++; |
| print $tstfh "-- GP_IGNORE: timeloop $tl_iter, ", |
| time(), "\n"; |
| goto l_timeloop; |
| } |
| |
| # undef $end_time; |
| $end_time = time() + $GH{tlim}; |
| } |
| } |
| |
| if (defined($realSTDOUT)) |
| { |
| close STDOUT; |
| open STDOUT, ">&", $realSTDOUT or die "Can't dup \$realSTDOUT: $!"; |
| |
| } |
| |
| } |
| else |
| { |
| my $do_para = $GH{parallel}; |
| |
| if (defined($GH{debug})) |
| { |
| my $timetxt = localtime(); |
| print "# start at $timetxt\n"; |
| print "# repeat $do_para times...\n"; |
| $do_para = 1; |
| } |
| |
| for my $ii (1..$do_para) |
| { |
| my $cmd; |
| |
| $cmd = $0 . " "; |
| |
| $cmd .= "--id=" . $GH{uid} . " "; |
| $cmd .= "--conn=\'" . $GH{connect} . "\' " |
| if (defined($GH{connect})); |
| $cmd .= "--iter=" . $GH{iter} . " "; |
| $cmd .= "--sqlfile=" . $GH{sqlfile} . " "; |
| |
| $cmd .= "--timelimit=\'" . $GH{tlim} . " seconds\' " |
| if (defined($GH{tlim})); |
| |
| $cmd .= "--tempdir=\'" . $GH{tmpdir} . "\' " |
| if (defined($GH{tmpdir})); |
| |
| $cmd .= "--grace_period=\'" . $GH{grace} . " seconds\' "; |
| |
| $cmd .= " & "; |
| |
| print $cmd, "\n"; |
| |
| unless (defined($GH{debug})) |
| { |
| print $tstfh $cmd, "\n"; |
| system($cmd); |
| } |
| |
| } # end for ii |
| |
| unless (defined($GH{debug})) |
| { |
| if (defined($GH{tlim})) |
| { |
| do_kill($GH{uid}, $GH{iter}, |
| $GH{tlim}, $GH{parallel}, $tstfh); |
| } |
| else |
| { |
| my $mon_stat = |
| init_monitor($GH{uid}, $GH{iter}, |
| $GH{tlim}, $GH{parallel}); |
| |
| $GH{mon_stat} = $mon_stat; |
| |
| while (do_monitor($mon_stat, 10, $tstfh)) |
| { |
| $GH{mon_stat} = $mon_stat; |
| } |
| } |
| } |
| |
| |
| } # end else |
| |
| close $tstfh; |
| undef $GH{test_fh}; |
| |
| } # end do_sql |
| |
| foreach my $signal (qw (INT TERM HUP)) { |
| $SIG{$signal} = \&do_handle_interrupt; # handle cntrl-c |
| } |
| |
| if (1) |
| { |
| if (defined($GH{sqlfile}) |
| && length($GH{sqlfile})) |
| { |
| do_sql(); |
| } |
| |
| } |
| |
| exit(); |
| |
