Gecko [ www.jdcpatala.org ]

Name	Size	Permission
My	[ DIR ]	drwxr-xr-x
v1	[ DIR ]	drwxr-xr-x
mtr_cases.pm	38.71 KB	-rw-r--r--
mtr_cases_from_list.pm	3 KB	-rw-r--r--
mtr_gcov.pl	2.43 KB	-rw-r--r--
mtr_gprof.pl	1.71 KB	-rw-r--r--
mtr_io.pl	3.26 KB	-rw-r--r--
mtr_match.pm	2.4 KB	-rw-r--r--
mtr_misc.pl	7.39 KB	-rw-r--r--
mtr_process.pl	4.14 KB	-rw-r--r--
mtr_report.pm	25.85 KB	-rw-r--r--
mtr_results.pm	4.28 KB	-rw-r--r--
mtr_stress.pl	6.46 KB	-rw-r--r--
mtr_unique.pm	3.86 KB	-rw-r--r--

Code Editor : mtr_misc.pl

# -*- cperl -*-
# Copyright (c) 2004, 2022, Oracle and/or its affiliates.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 2.0,
# as published by the Free Software Foundation.
#
# This program is also distributed with certain software (including
# but not limited to OpenSSL) that is licensed under separate terms,
# as designated in a particular file or component or in included license
# documentation.  The authors of MySQL hereby grant you an additional
# permission to link the program and your derivative works with the
# separately licensed software that they have included with MySQL.
#
# 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, version 2.0, 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= (
  'collect' => 0,
  'restart' => 0,
  'check'   => 0,
  'ch-warn' => 0,
  'test'    => 0,
  'init'    => 0,
  'admin'   => 0,
);

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();
}

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");
  }
}

${this.title}

Code Editor : mtr_misc.pl