use strict;
use warnings;
use LWP::Simple;
use DBI;
use Cache::Memcached;

# NOTE: Env variable MEMCACHED_PORT is mandatory
# for this perl script to work.
my $memcached_port=$ENV{'MEMCACHED_PORT'} or die;

my $memd = new Cache::Memcached {
  'servers' => [ "127.0.0.1:$memcached_port" ],
  'connect_timeout' => 20,
  'select_timeout' => 20
};

# /** Retrieve SDI stored in a tablespace for single copy.
# @param[in]	id_full		SDI id in format "sdi_<number>"
# @param[in]	type		SDI type
# @param[in] 	copy_num 	SDI copy number in a tablespace (0 or 1)
# @param[in] 	expected_data 	expected string to compare with SDI retrieved
#				from tablespace. */
sub sdi_get_from_copy {
	if (scalar(@_) ne 4) {
		die "Wrong number of arguments passed."
		. " Expected args: (id_full, type, copy_num, expected_data)\n";
	}
	my $id_full = $_[0];
	my $type = $_[1];
	my $copy_num = $_[2];
	my $expected_data = $_[3];

	my $val = $memd->get("$id_full:$type:$copy_num");
	my $cmp_result = $expected_data eq $val;

	if (!$cmp_result) {
		print "input and output mismatch for rec($id_full:$type)"
		. " from copy $copy_num\n";
		print "input is $expected_data\n";
		print "output is $val\n";
	}
}

# /** Inserts SDI into both copies and retrieve SDI stored to compare with the
# given data.
# @param[in]	id		SDI id (just the number)
# @param[in]	type		SDI type
# @param[in] 	data 		data to be inserted */
sub sdi_set_get {
	if (scalar(@_) ne 3) {
		die "Wrong number of arguments passed."
		. " Expected args: (id, type, data)\n";
	}

	my $id = $_[0];
	my $id_full= "sdi_" . $id;
	my $type = $_[1];
	my $data = $_[2];

	if (!$memd->set("$id_full:$type", $data)) {
		print "Error: $id:$type|$data cannot be inserted.\n";
	}

	# Retrieve from Copy 0
	sdi_get_from_copy($id_full, $type, 0, $data);
	# Retrieve from Copy 1
	sdi_get_from_copy($id_full, $type, 1, $data);
}

# /** Removes SDI from both copies and verifies the operation by expecting empty
# output on get.
# @param[in]	id	SDI id
# @param[in]	type	SDi type */
sub sdi_remove_get {

	if (scalar(@_) ne 2) {
		die "Wrong number of arguments passed."
		. " Expected args: (id, type)\n";
	}

	my $id = $_[0];
	my $id_full= "sdi_" . $id;
	my $type = $_[1];

	my $ret = $memd->delete("$id_full:$type");
	if (!$ret) {
		print "Error: rec($id:$type) cannot be deleted\n";
	}

	# Retrieve from copy 0
	my $val = $memd->get("$id_full:$type:0");
	if ($val) {
		print "Deleted but rec($id:$type:0) still exists with value:$val\n";
	}

	# Retrieve from copy 1
	$val = $memd->get("$id_full:$type:1");
	if ($val) {
		print "Deleted but rec($id:$type:1) still exists with value:$val\n";
	}
}

# /** Retrieve SDI from copy.
# @param[in]	id 	SDI id
# @param[in]	type	SDI type */
sub sdi_get {

	if (scalar(@_) ne 2) {
		die "Wrong number of arguments passed."
	        . " Expected args: (id, type)\n";
	}

	my $id = $_[0];
	my $id_full= "sdi_" . $id;
	my $type = $_[1];

	my $val = $memd->get("$id_full:$type");
	# We don't print id & type because we use TABLE_ID as SDI KEY &
	# type.
	print "Get rec(id:type) is $val\n";
}

# /** Create SDI index in a tablespace. */
sub sdi_create_index {
	$memd->get("sdi_create_");
}

# /** Removes SDI indexes in a tablespace. */
sub sdi_drop_index {
	$memd->get("sdi_drop_");
}

# /** Select the table on which SDI operations should happen.
# @param[in]	table_name	table name */
sub sdi_switch_table {
	if (scalar(@_) ne 1) {
		die "Wrong number of arguments passed."
		. " Expected args: (table_name)\n";
	}
	my $table_name = $_[0];
	$memd->get("\@\@$table_name");
}

# /** Retrieves SDI keys only without data. (1:1|2:4|..) */
sub sdi_get_only_keys {
	return $memd->get("sdi_list_");
}

# /** Disconnect the current memcached connection. */
sub sdi_disconnect {
	$memd->disconnect_all;
}

# "require sdi_perl_func.pl" says the module should return true and this
# achieved by the below statement
1;


# -*- cperl -*-
# Copyright (c) 2004, 2011, Oracle and/or its affiliates. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;

sub gcov_prepare ($) {
  my ($dir)= @_;
  print "Purging gcov information from '$dir'...\n";

  system("find $dir -name \*.gcov -o -name \*.da"
             . " -o -name \*.gcda | grep -v 'README.gcov\$' | xargs rm");
}

#
# Collect gcov statistics.
# Arguments:
#   $dir       basedir, normally build directory
#   $gcov      gcov utility program [path] name
#   $gcov_msg  message file name
#   $gcov_err  error file name
#
sub gcov_collect ($$$) {
  my ($dir, $gcov, $gcov_msg, $gcov_err)= @_;

  # Get current directory to return to later.
  my $start_dir= cwd();

  print "Collecting source coverage info using '$gcov'...\n";
  -f "$dir/$gcov_msg" and unlink("$dir/$gcov_msg");
  -f "$dir/$gcov_err" and unlink("$dir/$gcov_err");

  my @dirs= `find "$dir" -type d -print | sort`;
  #print "List of directories:\n@dirs\n";

  foreach my $d ( @dirs ) {
    chomp($d);
    chdir($d) or next;

    my @flist= glob("*.*.gcno");
    print ("Collecting in '$d'...\n") if @flist;

    foreach my $f (@flist) {
      system("$gcov $f 2>>$dir/$gcov_err >>$dir/$gcov_msg");
    }
    chdir($start_dir);
  }
  print "gcov info in $dir/$gcov_msg, errors in $dir/$gcov_err\n";
}

1;


# -*- cperl -*-
# Copyright (c) 2004, 2011, Oracle and/or its affiliates. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;

sub gprof_collect ($@) {
  my ($exe_mysqld, @gprof_dirs)= @_;

  print ("Collecting gprof reports.....\n");

  foreach my $datadir (@gprof_dirs)
  {
    my $gprof_msg= "$datadir/gprof.msg";
    my $gprof_err= "$datadir/gprof.err";
    if ( -f "$datadir/gmon.out" )
    {
      system("gprof $exe_mysqld $datadir/gmon.out 2>$gprof_err >$gprof_msg");
      print ("GPROF output in $gprof_msg, errors in $gprof_err\n");
    }
  }
}

1;


# -*- cperl -*-
# Copyright (c) 2004-2008 MySQL AB, 2008 Sun Microsystems, Inc.
# Use is subject to license terms.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;
use Carp;

sub mtr_fromfile ($);
sub mtr_tofile ($@);
sub mtr_tonewfile($@);
sub mtr_appendfile_to_file ($$);
sub mtr_grab_file($);
sub mtr_printfile($);
sub mtr_lastlinesfromfile ($$);

# Read a whole file, stripping leading and trailing whitespace.
sub mtr_fromfile ($) {
  my $file=  shift;

  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  my $text= join('', <FILE>);
  close FILE;
  $text =~ s/^\s+//;                    # Remove starting space, incl newlines
  $text =~ s/\s+$//;                    # Remove ending space, incl newlines
  return $text;
}

sub mtr_tofile ($@) {
  my $file=  shift;

  open(FILE,">>",$file) or mtr_error("can't open file \"$file\": $!");
  print FILE join("", @_);
  close FILE;
}

sub mtr_tonewfile ($@) {
  my $file=  shift;

  open(FILE,">",$file) or mtr_error("can't open file \"$file\": $!");
  print FILE join("", @_);
  close FILE;
}

sub mtr_appendfile_to_file ($$) {
  my $from_file=  shift;
  my $to_file=  shift;

  open(TOFILE,">>",$to_file) or mtr_error("can't open file \"$to_file\": $!");
  open(FROMFILE,"<",$from_file)
    or mtr_error("can't open file \"$from_file\": $!");
  print TOFILE while (<FROMFILE>);
  close FROMFILE;
  close TOFILE;
}

# Read a whole file verbatim.
sub mtr_grab_file($) {
  my $file= shift;
  open(FILE, '<', $file)
    or return undef;
  local $/= undef;
  my $data= scalar(<FILE>);
  close FILE;
  return $data;
}

# Print the file to STDOUT
sub mtr_printfile($) {
  my $file= shift;
  open(FILE, '<', $file)
    or warn $!;
  print while(<FILE>);
  close FILE;
  return;
}

sub mtr_lastlinesfromfile ($$) {
  croak "usage: mtr_lastlinesfromfile(file,numlines)" unless (@_ == 2);
  my ($file, $num_lines)= @_;
  my $text;
  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  my @lines= reverse <FILE>;
  close FILE;
  my $size= scalar(@lines);
  $num_lines= $size unless ($size >= $num_lines);
  return join("", reverse(splice(@lines, 0, $num_lines)));
}

1;


# -*- cperl -*-
# Copyright (c) 2004, 2016 Oracle and/or its affiliates. All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;

use My::Platform;

sub mtr_init_args ($);
sub mtr_add_arg ($$@);
sub mtr_args2str($@);
sub mtr_path_exists(@);
sub mtr_script_exists(@);
sub mtr_file_exists(@);
sub mtr_exe_exists(@);
sub mtr_exe_maybe_exists(@);
sub mtr_compress_file($);
sub mtr_milli_sleep($);
sub start_timer($);
sub has_expired($);
sub init_timers();
sub mark_time_used($);
sub mark_time_idle();
sub add_total_times($);
sub print_times_used($$);
sub print_total_times($);

our $opt_report_times;

##############################################################################
#
#  Args
#
##############################################################################

sub mtr_init_args ($) {
  my $args = shift;
  $$args = [];                            # Empty list
}

sub mtr_add_arg ($$@) {
  my $args=   shift;
  my $format= shift;
  my @fargs = @_;

  # Quote args if args contain space
  $format= "\"$format\""
    if (IS_WINDOWS and grep(/\s/, @fargs));

  push(@$args, sprintf($format, @fargs));
}

sub mtr_args2str($@) {
  my $exe=   shift or die;
  return join(" ", native_path($exe), @_);
}

##############################################################################

#
# NOTE! More specific paths should be given before less specific.
# For example /client/debug should be listed before /client
#
sub mtr_path_exists (@) {
  foreach my $path ( @_ )
  {
    return $path if -e $path;
  }
  if ( @_ == 1 )
  {
    mtr_error("Could not find $_[0]");
  }
  else
  {
    mtr_error("Could not find any of " . join(" ", @_));
  }
}

#
# NOTE! More specific paths should be given before less specific.
# For example /client/debug should be listed before /client
#
sub mtr_script_exists (@) {
  foreach my $path ( @_ )
  {
    if(IS_WINDOWS)
    {
      return $path if -f $path;
    }
    else
    {
      return $path if -x $path;
    }
  }
  if ( @_ == 1 )
  {
    mtr_error("Could not find $_[0]");
  }
  else
  {
    mtr_error("Could not find any of " . join(" ", @_));
  }
}

#
# NOTE! More specific paths should be given before less specific.
# For example /client/debug should be listed before /client
#
sub mtr_file_exists (@) {
  foreach my $path ( @_ )
  {
    return $path if -e $path;
  }
  return "";
}

#
# NOTE! More specific paths should be given before less specific.
# For example /client/debug should be listed before /client
#
sub mtr_exe_maybe_exists (@) {
  my @path= @_;

  map {$_.= ".exe"} @path if IS_WINDOWS;
  foreach my $path ( @path )
  {
    if(IS_WINDOWS)
    {
      return $path if -f $path;
    }
    else
    {
      return $path if -x $path;
    }
  }
  return "";
}

#
# NOTE! More specific paths should be given before less specific.
#
sub mtr_pl_maybe_exists (@) {
  my @path= @_;

  map {$_.= ".pl"} @path if IS_WINDOWS;
  foreach my $path ( @path )
  {
    if(IS_WINDOWS)
    {
      return $path if -f $path;
    }
    else
    {
      return $path if -x $path;
    }
  }
  return "";
}

#
# NOTE! More specific paths should be given before less specific.
# For example /client/debug should be listed before /client
#
sub mtr_exe_exists (@) {
  my @path= @_;
  if (my $path= mtr_exe_maybe_exists(@path))
  {
    return $path;
  }
  # Could not find exe, show error
  if ( @path == 1 )
  {
    mtr_error("Could not find $path[0]");
  }
  else
  {
    mtr_error("Could not find any of " . join(" ", @path));
  }
}

#
# Try to compress file using tools that might be available.
# If zip/gzip is not available, just silently ignore.
#

sub mtr_compress_file ($) {
  my ($filename)= @_;

  mtr_error ("File to compress not found: $filename") unless -f $filename;

  my $did_compress= 0;

  if (IS_WINDOWS)
  {
    # Capture stderr
    my $ziperr= `zip $filename.zip $filename 2>&1`;
    if ($?) {
      print "$ziperr\n" if $ziperr !~ /recognized as an internal or external/;
    } else {
      unlink($filename);
      $did_compress=1;
    }
  }
  else
  {
    my $gzres= system("gzip $filename");
    $did_compress= ! $gzres;
    if ($gzres && $gzres != -1) {
      mtr_error ("Error: have gzip but it fails to compress core file");
    }
  }
  mtr_print("Compressed file $filename") if $did_compress;
}

sub mtr_milli_sleep ($) {
  die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1;
  my ($millis)= @_;

  select(undef, undef, undef, ($millis/1000));
}

# Simple functions to start and check timers (have to be actively polled)
# Timer can be "killed" by setting it to 0

sub start_timer ($) { return time + $_[0]; }

sub has_expired ($) { return $_[0] && time gt $_[0]; }

# Below code is for time usage reporting

use Time::HiRes qw(gettimeofday);

my %time_used;

my %time_text= (
 'collect' => "Collecting test cases",
 'restart' => "Server stop/start",
 'check'   => "Check-testcase",
 'ch-warn' => "Check for warnings",
 'test'    => "Test execution",
 'init'    => "Initialization/cleanup",
 'admin'   => "Test administration",
);

# Counts number of reports from workers

my $time_totals= 0;

my $last_timer_set;

sub init_timers() {
  $last_timer_set= gettimeofday();

  # Initialize the 'time_used' hash for each worker
  %time_used= (
    'collect' => 0,
    'restart' => 0,
    'check'   => 0,
    'ch-warn' => 0,
    'test'    => 0,
    'init'    => 0,
    'admin'   => 0,
  );
}

sub mark_time_used($) {
  my ($name)= @_;
  return unless $opt_report_times;
  die "Unknown timer $name" unless exists $time_used{$name};

  my $curr_time= gettimeofday();
  $time_used{$name}+= int (($curr_time - $last_timer_set) * 1000 + .5);
  $last_timer_set= $curr_time;
}

sub mark_time_idle() {
  $last_timer_set= gettimeofday() if $opt_report_times;
}

sub add_total_times($) {
  my ($dummy, $num, @line)= split (" ", $_[0]);

  $time_totals++;
  foreach my $elem (@line) {
    my ($name, $spent)= split (":", $elem);
    $time_used{$name}+= $spent;
  }
}

sub print_times_used($$) {
  my ($server, $num)= @_;
  return unless $opt_report_times;

  my $output= "SPENT $num";
  foreach my $name (keys %time_used) {
    my $spent= $time_used{$name};
    $output.= " $name:$spent";
  }
  print $server $output . "\n";
}

sub print_total_times($) {
  # Don't print if we haven't received all worker data
  return if $time_totals != $_[0];

  foreach my $name (keys %time_used)
  {
    my $spent= $time_used{$name}/1000;
    my $text= $time_text{$name};
    print ("Spent $spent seconds on $text\n");
  }
}

1;


# -*- cperl -*-
# Copyright (c) 2004, 2016, Oracle and/or its affiliates. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;
use Socket;
use Errno;
use My::Platform;
use if IS_WINDOWS, "Net::Ping";

# Ancient perl might not have port_number method for Net::Ping.
# Check it and use fallback to connect() if it is not present.
BEGIN
{
  my $use_netping= 0;
  if (IS_WINDOWS)
  {
    my $ping = Net::Ping->new();
    if ($ping->can("port_number"))
    {
      $use_netping= 1;
    }
  }
  eval 'sub USE_NETPING { $use_netping }';
}

sub sleep_until_file_created ($$$);
sub mtr_ping_port ($);

sub mtr_ping_port ($) {
  my $port= shift;

  mtr_verbose("mtr_ping_port: $port");

  if (IS_WINDOWS && USE_NETPING)
  {
    # Under Windows, connect to a port that is not open is slow
    # It takes ~1sec. Net::Ping with small timeout is much faster.
    my $ping = Net::Ping->new();
    $ping->port_number($port);
    if ($ping->ping("localhost",0.1))
    {
      mtr_verbose("USED");
      return 1;
    }
    else
    {
      mtr_verbose("FREE");
      return 0;
    }
  }

  my $remote= "localhost";
  my $iaddr=  inet_aton($remote);
  if ( ! $iaddr )
  {
    mtr_error("can't find IP number for $remote");
  }
  my $paddr=  sockaddr_in($port, $iaddr);
  my $proto=  getprotobyname('tcp');
  if ( ! socket(SOCK, PF_INET, SOCK_STREAM, $proto) )
  {
    mtr_error("can't create socket: $!");
  }

  mtr_debug("Pinging server (port: $port)...");

  if ( connect(SOCK, $paddr) )
  {
    close(SOCK);                        # FIXME check error?
    mtr_verbose("USED");
    return 1;
  }
  else
  {
    mtr_verbose("FREE");
    return 0;
  }
}

##############################################################################
#
#  Wait for a file to be created
#
##############################################################################

# FIXME check that the pidfile contains the expected pid!

sub sleep_until_file_created ($$$) {
  my $pidfile= shift;
  my $timeout= shift;
  my $proc=     shift;
  my $sleeptime= 100; # Milliseconds
  my $loops= ($timeout * 1000) / $sleeptime;

  for ( my $loop= 1; $loop <= $loops; $loop++ )
  {
    if ( -r $pidfile )
    {
      return 1;
    }

    my $seconds= ($loop * $sleeptime) / 1000;

    # Check if it died after the fork() was successful
    if ( defined $proc and ! $proc->wait_one(0) )
    {
      mtr_warning("Process $proc died after mysql-test-run waited $seconds " .
		  "seconds for $pidfile to be created.");
      return 0;
    }

    mtr_debug("Sleep $sleeptime milliseconds waiting for $pidfile");

    my $message_timeout = 600; # 60 seconds wait between each message
    if ($ENV{'VALGRIND_TEST'}) {
      $message_timeout = $message_timeout * 5;
    }

    # Print extra message every $message_timeout seconds
    if ( $seconds > 1 && int($seconds * 10) % $message_timeout == 0 && $seconds < $timeout )
    {
      my $left= $timeout - $seconds;
      mtr_warning("Waited $seconds seconds for $pidfile to be created, " .
                  "still waiting for $left seconds...");
    }

    mtr_milli_sleep($sleeptime);

  }

  mtr_warning("Timeout after mysql-test-run waited $timeout seconds " .
	      "for the process $proc to create a pid file.");
  return 0;
}

1;


# -*- cperl -*-
# Copyright (c) 2004, 2016, Oracle and/or its affiliates. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.

use strict;
use File::Spec;

# These are not to be prefixed with "mtr_"

sub run_stress_test ();

##############################################################################
#
#  Run tests in the stress mode
#
##############################################################################

sub run_stress_test ()
{

  my $args;
  my $stress_suitedir;

  mtr_report("Starting stress testing\n");

  if ( ! mysqld_start($::master->[0],[],[]) )
  {
    mtr_error("Can't start the mysqld server");
  }

  my $stress_basedir=File::Spec->catdir($::opt_vardir, "stress");

  #Clean up stress dir
  if ( -d $stress_basedir )
  {
    rmtree($stress_basedir);
  }
  mkpath($stress_basedir);

  if ($::opt_stress_suite ne 'main' && $::opt_stress_suite ne 'default' )
  {
    $stress_suitedir=File::Spec->catdir($::glob_mysql_test_dir, "suite",
                                         $::opt_stress_suite);
  }
  else
  {
    $stress_suitedir=$::glob_mysql_test_dir;
  }

  if ( -d $stress_suitedir )
  {
    #$stress_suite_t_dir=File::Spec->catdir($stress_suitedir, "t");
    #$stress_suite_r_dir=File::Spec->catdir($stress_suitedir, "r");
    #FIXME: check dirs above for existence to ensure that test suite
    #       contains tests and results dirs
  }
  else
  {
    mtr_error("Specified test suite $::opt_stress_suite doesn't exist");
  }

  if ( @::opt_cases )
  {
    $::opt_stress_test_file=File::Spec->catfile($stress_basedir, "stress_tests.txt");
    open(STRESS_FILE, ">$::opt_stress_test_file");
    print STRESS_FILE join("\n",@::opt_cases),"\n";
    close(STRESS_FILE);
  }
  elsif ( $::opt_stress_test_file )
  {
    $::opt_stress_test_file=File::Spec->catfile($stress_suitedir,
                                              $::opt_stress_test_file);
    if ( ! -f $::opt_stress_test_file )
    {
      mtr_error("Specified file $::opt_stress_test_file with list of tests does not exist\n",
                "Please ensure that file exists and has proper permissions");
    }
  }
  else
  {
    $::opt_stress_test_file=File::Spec->catfile($stress_suitedir,
                                              "stress_tests.txt");
    if ( ! -f $::opt_stress_test_file )
    {
      mtr_error("Default file $::opt_stress_test_file with list of tests does not exist\n",
          "Please use --stress-test-file option to specify custom one or you can\n",
          "just specify name of test for testing as last argument in command line");

    }
  }

  if ( $::opt_stress_init_file )
  {
    $::opt_stress_init_file=File::Spec->catfile($stress_suitedir,
                                              $::opt_stress_init_file);
    if ( ! -f $::opt_stress_init_file )
    {
      mtr_error("Specified file $::opt_stress_init_file with list of tests does not exist\n",
                "Please ensure that file exists and has proper permissions");
    }
  }
  else
  {
    $::opt_stress_init_file=File::Spec->catfile($stress_suitedir,
                                              "stress_init.txt");
    if ( ! -f $::opt_stress_init_file )
    {
      $::opt_stress_init_file='';
    }
  }

  if ( $::opt_stress_mode ne 'random' && $::opt_stress_mode ne 'seq' )
  {
    mtr_error("You specified wrong mode $::opt_stress_mode for stress test\n",
              "Correct values are 'random' or 'seq'");
  }

  mtr_init_args(\$args);
  mtr_add_args($args, "$::glob_mysql_test_dir/mysql-stress-test.pl");
  mtr_add_arg($args, "--server-socket=%s", $::master->[0]->{'path_sock'});
  mtr_add_arg($args, "--server-user=%s", $::opt_user);
  mtr_add_arg($args, "--server-database=%s", "test");
  mtr_add_arg($args, "--stress-suite-basedir=%s", $::glob_mysql_test_dir);
  mtr_add_arg($args, "--suite=%s", $::opt_stress_suite);
  mtr_add_arg($args, "--stress-tests-file=%s", $::opt_stress_test_file);
  mtr_add_arg($args, "--stress-basedir=%s", $stress_basedir);
  mtr_add_arg($args, "--server-logs-dir=%s", $stress_basedir);
  mtr_add_arg($args, "--stress-mode=%s", $::opt_stress_mode);
  mtr_add_arg($args, "--mysqltest=%s", $::exe_mysqltest);
  mtr_add_arg($args, "--threads=%s", $::opt_stress_threads);
  mtr_add_arg($args, "--verbose");
  mtr_add_arg($args, "--cleanup");
  mtr_add_arg($args, "--log-error-details");
  mtr_add_arg($args, "--abort-on-error=1");

  if ( $::opt_stress_init_file )
  {
    mtr_add_arg($args, "--stress-init-file=%s", $::opt_stress_init_file);
  }

  if ( !$::opt_stress_loop_count && !$::opt_stress_test_count &&
       !$::opt_stress_test_duration )
  {
    #Limit stress testing with 20 loops in case when any limit parameter
    #was specified
    $::opt_stress_test_count=20;
  }

  if ( $::opt_stress_loop_count )
  {
    mtr_add_arg($args, "--loop-count=%s", $::opt_stress_loop_count);
  }

  if ( $::opt_stress_test_count )
  {
    mtr_add_arg($args, "--test-count=%s", $::opt_stress_test_count);
  }

  if ( $::opt_stress_test_duration )
  {
    mtr_add_arg($args, "--test-duration=%s", $::opt_stress_test_duration);
  }

  #Run stress test
  My::SafeProcess->run
      (
       name           => "stress test",
       path           => $^X,
       args           => \$args,
      );

  stop_all_servers();
}

1;


#!/usr/bin/perl
# -*- cperl -*-

# Copyright (c) 2007 MySQL AB
# Use is subject to license terms.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA

use strict;
use Getopt::Long;
use IO::File;

my $vardir;
my $randie= 0;
my $sleep= 0;
GetOptions
  (
   # Directory where to write files
   'vardir=s'     => \$vardir,
   'die-randomly' => \$randie,
   'sleep=i'      => \$sleep,
  );

die("invalid vardir ") unless defined $vardir and -d $vardir;

my $pid= $$;
while(1){
  for my $i (1..64){
    # Write to file
    my $name= "$vardir/$pid.$i.tmp";
    my $F= IO::File->new($name, "w")
      or warn "$$, Could not open $name: $!" and next;
    print $F rand($.) for (1..1000);
    $F->close();
    sleep($sleep);
    die "ooops!" if $randie and rand() < 0.0001
  }
}

exit (0);


#!/usr/bin/perl
# -*- cperl -*-

# Copyright (c) 2007, 2008 MySQL AB
# Use is subject to license terms.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA

use strict;
use FindBin;
use My::SafeProcess;

#
# Test longterm running of SafeProcess
#

my $perl_path= $^X;
my $verbose= 0;
my $loops= 100;

print "kill one and wait for one\n";
for (1...$loops){
  use File::Temp qw / tempdir /;
  my $dir = tempdir( CLEANUP => 1 );

  my @procs;
  for (1..10){

    my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
    my $proc= My::SafeProcess->new
      (
       path          => $perl_path,
       args          => \$args,
       verbose       => $verbose,
      );
    push(@procs, $proc);
  }

  foreach my $proc (@procs) {
    $proc->kill();
    # dummyd will always be killed and thus
    # exit_status should have been set to 1
    die "oops, exit_status: ", $proc->exit_status()
      unless $proc->exit_status() == 1;
  }

  print "=" x 60, "\n";
}

print "With 1 second sleep in dummyd\n";
for (1...$loops){
  use File::Temp qw / tempdir /;
  my $dir = tempdir( CLEANUP => 1 );

  my @procs;
  for (1..10){

    my $args= [ "$FindBin::Bin/dummyd.pl",
		"--vardir=$dir",
		"--sleep=1" ];
    my $proc= My::SafeProcess->new
      (
       path          => $perl_path,
       args          => \$args,
       verbose       => $verbose,
      );
    push(@procs, $proc);
  }

  foreach my $proc (@procs) {
    $proc->kill();
  }

  print "=" x 60, "\n";
}

print "kill all and wait for one\n";
for (1...$loops){
  use File::Temp qw / tempdir /;
  my $dir = tempdir( CLEANUP => 1 );

  my @procs;
  for (1..10){

    my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
    my $proc= My::SafeProcess->new
      (
       path          => $perl_path,
       args          => \$args,
       verbose       => $verbose,
      );
    push(@procs, $proc);
  }

  foreach my $proc (@procs) {
    $proc->start_kill();
  }

  foreach my $proc (@procs) {
    $proc->wait_one();
  }

  print "=" x 60, "\n";
}

print "kill all using shutdown without callback\n";
for (1...$loops){
  use File::Temp qw / tempdir /;
  my $dir = tempdir( CLEANUP => 1 );

  my @procs;
  for (1..10){

    my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
    my $proc= My::SafeProcess->new
      (
       path          => $perl_path,
       args          => \$args,
       verbose       => $verbose,
       );
    push(@procs, $proc);
  }

  My::SafeProcess::shutdown(2, @procs);

  print "=" x 60, "\n";
}

print "kill all using shutdown\n";
for (1...$loops){
  use File::Temp qw / tempdir /;
  my $dir = tempdir( CLEANUP => 1 );

  my @procs;
  for (1..10){

    my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
    my $proc= My::SafeProcess->new
      (
       path          => $perl_path,
       args          => \$args,
       verbose       => $verbose,
       shutdown      => sub {  }, # Does nothing
      );
    push(@procs, $proc);
  }

  My::SafeProcess::shutdown(2, @procs);

  print "=" x 60, "\n";
}

exit(0);


#!/usr/bin/perl
# -*- cperl -*-

# Copyright (c) 2007 MySQL AB
# Use is subject to license terms.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA

use strict;
use Getopt::Long;

my $opt_exit_code= 0;

GetOptions
  (
   # Exit with the specified exit code
   'exit-code=i'   => \$opt_exit_code
  );

print "Hello stdout\n";
print STDERR "Hello stderr\n";

exit ($opt_exit_code);


#!/usr/bin/perl
################################################################################
#
# This script runs the transactional stress test "stress_tx_rr" against the
# transactional storage engine and looks for errors in two log files:
#   var/stress/<timestamp>/mysql-stress-test.log
#   var/log/master.err
#
# The script assumes current working dir is mysql-test/.
#
# Regarding the server error log, currently only error lines containing the
# string "Error:" will be reported as a critical error, in addition to signs
# of crashes.
#
# In the stress test log, all lines matching the regex "S\d:" (denoting an
# error with a specified severity) will be reported as errors.
#
# Error information including the full server log in the case of server crash
# is output to standard out.
#
# This script is and should be silent if no errors are detected.
#
################################################################################

use File::Find;
use File::Spec;
use Cwd;
use Cwd 'abs_path';
use Getopt::Long;

# Checking script is run from the correct location
if (! -f "mysql-test-run.pl") {
   print("\nERROR: This script should be run from the \'\<INSTALL_DIR\>/mysql-test\' directory.\n");
   error(1);
}

$runlog="rr_trx.log";

my $errorFound;

my $installdir=abs_path(File::Spec->updir());

my $f=abs_path($0);
my ($v,$d,$f)=File::Spec->splitpath($f);
my $testsuitedir=$v.$d;

################################################################################
# Run stress test, redirect output to tmp file.
# Duration is specified in seconds. Some nice values:
#   5 minutes =   300
#  30 minutes =  1800
#   1 hour    =  3600
#   2 hours   =  7200
#   5 hours   = 18000
#  12 hours   = 43200
#
################################################################################
$opt_duration=600;

# Special handling for the InnoDB plugin
$plugin_params="\"--plugin-load=innodb=ha_innodb_plugin.so;innodb_trx=ha_innodb_plugin.so;innodb_locks=ha_innodb_plugin.so;innodb_cmp=ha_innodb_plugin.so;innodb_cmp_reset=ha_innodb_plugin.so;innodb_cmpmem=ha_innodb_plugin.so;innodb_cmpmem_reset=ha_innodb_plugin.so\"";
$plugin_params=~s/so/dll/g if (windows());

$opt_help="";
$opt_try="";
$opt_engine="";
$opt_threads=10;

# Collection command line options
GetOptions("engine:s"   => \$opt_engine,
           "duration=i" => \$opt_duration,
           "threads=i"  => \$opt_treads,
           "try", "help") || usage();

if ($opt_help) { usage(); }
if (!$opt_engine) {
   print("\nERROR: --engine=\<engine\> argument is required!!!\n");
   usage();
}

# setting specific engine parameters
$engine_options="";
  # for innodb engine
  if ($opt_engine eq "InnoDB") {
     $engine_options=
           "--mysqld=--innodb " .
           "--mysqld=--innodb-lock-wait-timeout=2 " .
           " ";
     }
  elsif ($opt_engine eq "InnoDB_plugin") {
        $engine_options=
           "--mysqld=--innodb " .
           "--mysqld=--ignore-builtin-innodb " .
           #"--mysqld=--plugin_dir=".$installdir."/lib " .
           "--mysqld=--plugin_dir=".$installdir."/storage/innodb_plugin/.libs " .
           "--mysqld=--innodb-lock-wait-timeout=2 " .
           "--mysqld=".$plugin_params." " .
           " ";
     }
  # add parameters for a new engine by modifying the 'elsif' section below
  elsif ($opt_engine eq "zz") {
        $engine_options=
           " ";
     }
  else  {
        print("\nERROR: '".$opt_engine."' - unknown engine\n");
        add_engine_help();
     }

# From this point forward there is no difference between the build in InnDB and the plugin
$opt_engine='InnoDB' if ($opt_engine eq 'InnoDB_plugin');

# checking that custom files for that engine exist
$engine_lower= lc($opt_engine);
$missing=0;
if (!-f $testsuitedir.'init_'.$engine_lower.'.txt') {
   print("\nERROR: config file 'init_".$engine_lower.".txt' missing.");
   $missing=1;
}
if (!-f $testsuitedir.'t/init_'.$engine_lower.'.test') {
   print("\nERROR: config file 'init_".$engine_lower.".test' missing.");
   $missing=1;
}
if (!-f $testsuitedir.'r/init_'.$engine_lower.'.result') {
   print("\nERROR: config file 'init_".$engine_lower.".result' missing.");
   $missing=1;
}
add_engine_help() if ($missing);

# bilding test command line
$cmd="MTR_VERSION=1 " .
    "perl ./mysql-test-run.pl " .
    "--comment=stress_tx_rr_".$opt_engine." " .
    "--stress " .
    "--stress-init-file=init_".$engine_lower.".txt " .
    "--stress-test-file=run.txt " .
    "--stress-suite=engines/rr_trx " .
    "--stress-test-duration=".$opt_duration." " .
    "--stress-threads=".$opt_threads."  " .
    "--mysqld=--log-output=file " .
    "--mysqld=--sql-mode=no_engine_substitution " .
    "--skip-im " .
    "--skip-ndb " .
    $engine_options .
    " > ".$runlog." 2>&1";

# running the test
print("\n   Running \'rr_trx\' test with ".$opt_threads." clients\n");
print("   for ".$opt_duration." seconds using the ".$opt_engine." storag engine.\n");
print("\n   Log file: ".$runlog."\n");
if ($opt_try) {
   print("\nThe following command will execute:\n");
   print("$cmd\n\n");
   exit(0);
}
system $cmd;

################################################################################
# Check for crash and other severe errors in the server log.
#
################################################################################

# Open log file. If MTR_VERSION=1 this is in var/log/master.err.
# Otherwise, it is in ?... [stress_tx_rr not yet runnable with MTR_VERSION=2]
# Assuming current directory mysql-test/
my $serverlog=getcwd() . "/var/log/master.err";

open(SERVERLOG, $serverlog)
    or die "Unable to open $serverlog. Test not run?";
my @servererrors = ();  # Lines with "Severe" errors in server error log
my @crash = ();    # Empty if no stack trace detected, non-empty otherwise.

# Grep for errors and crashes. Going line-by-line since the file can be large.
while (<SERVERLOG>) {
    $line = $_;
    push @crash, $line if /This could be because you hit a bug/;
    push @servererrors, $line if /Error:/;
}
close(SERVERLOG);

if (@crash) {
    # Crash (stack trace) detected in server log.
    print "Transactional stress test stress_tx_rr:\n\n";
    print "SERVER CRASH DETECTED!\n";
    print "Server log: $serverlog printed at the bottom of this log.\n\n";
    print "########################################################\n\n";
}
if (@servererrors) {
    # "Severe" errors detected. Print error lines to std out
    print "CRITICAL ERRORS:\n\n";
    foreach $error (@servererrors) {
        print $error;
    }
    print "\n########################################################\n\n";
}

################################################################################
# Check for errors reported by mysql-stress-test.pl. Transactional consistency
# issues are shown as result diffs.
################################################################################

my $dir;
find(\&finddir, cwd);  # sets variable $dir

# Open log file
my $logfile="$dir/mysql-stress-test.log";
open(LOGFILE, $logfile)
    or die "Unable to open $logfile. Test not run?";
my @errors = ();
my @heading = ();

# Grep for errors. Going line-by-line since the file can be large.
while (<LOGFILE>) {
    #push @errors, $_ if ! /No Errors/;
    push @errors, $_ if /S\d:/;
    push @heading, $_ if /TestID|=====/;
}
close(LOGFILE);

# Print all errors, i.e. all lines that do not contain the string "No Errors"
if (@errors) {
    $errorFound = 1;
    print "Stress test main log file: $logfile\n";
    print "Errors follow:\n\n";
    # First print the heading
    foreach $header_line (@heading) {
        print $header_line;
    }
    foreach $error (@errors) {
        print $error;
    }
}

# If errors in server log, output the log and exit 1?
if (@servererrors or @crash) {
    $errorFound = 1;
    print "\n########################################################\n\n";
    print "Server error log (master.err):\n\n";

    open(SERVERLOG, $serverlog)
        or die "Unable to open $serverlog!";

    while (<SERVERLOG>) {
        print $_;
    }
    close(SERVERLOG);
}

if ($errorFound) {
    # Exit with error code != 0 if we found an error.
    print("\nTest Completed with errors. \n");
    print(" - See ".$runlog." for summary.\n");
    print(" - See files under var/stress for details.\n");
    exit 1;
}

print("\nTest Completed - See ".$runlog." for details\n");
################################################################################
# Helper routines etc.
#
################################################################################

sub finddir {
  my $file = $File::Find::name;       # complete path to the file

  return unless -d $file;             # process directories (-d), not files (-f)
  return unless $_ =~ m/^\d{14}$/;    # check if file matches timstamp regex,
                                      # must be 14 digits
  $dir=$file;
  #$dir= $_;                          # $_ = just the file name, no path
  return $_;
}

sub usage
{
  print <<EOF;

SYNTAX $0 --engine=<engine> [--duration=<nn>] [--thread=<nn>] [--try]

  --engine=<engine>
    The engine used to run the test. \<engine\> needs to be provided exactly as
    it is reprted in the SHOW ENGINES comand.
    EXCEPTION: In order to use the InnoDB plugin, specify 'InnoDB_plugin'
  Required option.

  --duration=nn
    The time the test should run for in seconds. Defaut value is 600 seconds (10 minutes).
  Optional parameter

  --threads=nn
    The number of clients used by the test driver. Defaut value is 10.
  Optional parameter

  --try
    Do not run the actual test but show what will be run
  Optional parameter

EOF

exit(0);
}

sub add_engine_help
{
  print <<EOF;

\nThis test is can be run against any transactional engine. However scripts need to be modifed in order
to support such engines (support to InnoDB is provided as an example).
In order to add support for a new engine, you will need to modify scripts as follows:
   1) cd to INSTALL_DIR/mysql-test/suite/engines/rr_trx
   2) Modify the 'run_stress_rr.pl' file by adding an 'elsif' section for your engine and have it
      include specifc values required to be passed as startup parameters to the MySQL server by
      specifying them using "--mysqld" options (see InnoDB example).
   3) Copy the 'init_innodb.txt' file to 'init_<engine>.txt file and change its content to be "init_<engine>".
   4) In the 't' directory copy the "init_innodb.test" file to "init_\<engine\>.test" and change the value of
      the '\$engine' variable to \<engine\>.
   5) In the 'r' directory copy "the init_innodb.result" file to "init_\<engine\>.result" and change refrences
      to 'InnoDB' to \<engine\>.

EOF

exit(0);
}

sub windows {
        if (
                ($^O eq 'MSWin32') ||
                ($^O eq 'MSWin64')
        ) {
                return 1;
        } else {
                return 0;
        }
}