mariadb/mysql-test/lib/My/Find.pm

# -*- cperl -*-
# Copyright (C) 2004-2006 MySQL AB
#
# 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


package My::Find;

#
# Utility functions to find files in a MySQL source or bindist
#

use strict;
use Carp;
use My::Platform;

use base qw(Exporter);
our @EXPORT= qw(my_find_bin my_find_dir NOT_REQUIRED);

our $vs_config_dir;

my $bin_extension= ".exe" if IS_WINDOWS;

# Helper function to be used for fourth parameter to find functions
sub NOT_REQUIRED { return 0; }

#
# my_find_bin - find an executable with "name_1...name_n" in
# paths "path_1...path_n" and return the full path
#
# Example:
#    my $mysqld_exe= my_find_bin($basedir.
#                                ["sql", "bin"],
#                                ["mysqld", "mysqld-debug"]);
#    my $mysql_exe= my_find_bin($basedir,
#                               ["client", "bin"],
#                               "mysql");
#
#
#    To check if something exists, use the required parameter
#    set to 0, the function will return an empty string if the
#    binary is not found
#    my $mysql_exe= my_find_bin($basedir,
#                               ["client", "bin"],
#                               "mysql", 0);
#
# NOTE: The function honours MTR_VS_CONFIG environment variable
#
#
sub my_find_bin {
  my ($base, $paths, $names, $required)= @_;
  croak "usage: my_find_bin(<base>, <paths>, <names>, [<required>])"
    unless @_ == 4 or @_ == 3;

  # -------------------------------------------------------
  # Find and return the first executable
  # -------------------------------------------------------
  foreach my $path (my_find_paths($base, $paths, $names, $bin_extension)) {
    return $path if ( -x $path or (IS_WINDOWS and -f $path) );
  }
  if (defined $required and $required == NOT_REQUIRED){
    # Return empty string to indicate not found
    return "";
  }
  find_error($base, $paths, $names);
}


#
# my_find_dir - find the first existing directory in one of
# the given paths
#
# Example:
#    my $charset_set= my_find_dir($basedir,
#                                 ["mysql/share","sql/share", "share"],
#                                 ["charset"]);
# or
#    my $charset_set= my_find_dir($basedir,
#                                 ['client_release', 'client_debug',
#			           'client', 'bin']);
#
# NOTE: The function honours MTR_VS_CONFIG environment variable
#
#
sub my_find_dir {
  my ($base, $paths, $dirs, $required)= @_;
  croak "usage: my_find_dir(<base>, <paths>[, <dirs>])"
    unless (@_ == 3 or @_ == 2);

  # -------------------------------------------------------
  # Find and return the first directory
  # -------------------------------------------------------
  foreach my $path (my_find_paths($base, $paths, $dirs)) {
    return $path if ( -d $path );
  }
  find_error($base, $paths, $dirs);
}


sub my_find_paths {
  my ($base, $paths, $names, $extension)= @_;

  # Convert the arguments into two normal arrays to ease
  # further mappings
  my (@names, @paths);
  push(@names, ref $names eq "ARRAY" ? @$names : $names);
  push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);

  #print "base: $base\n";
  #print "names: @names\n";
  #print "paths: @paths\n";

  # User can select to look in a special build dir
  # which is a subdirectory of any of the paths
  my @extra_dirs;
  my $build_dir= $vs_config_dir || $ENV{MTR_VS_CONFIG} || $ENV{MTR_BUILD_DIR};
  push(@extra_dirs, $build_dir) if defined $build_dir;

  if (defined $extension){
    # Append extension to names, if name does not already have extension
    map { $_.=$extension unless /\.(.*)+$/ } @names;
  }

  # -------------------------------------------------------
  # Windows specific
  # -------------------------------------------------------
  if (IS_WINDOWS) {
    # Add the default extra build dirs unless a specific one has
    # already been selected
    push(@extra_dirs,
	 ("release",
	  "relwithdebinfo",
	  "debug")) if @extra_dirs == 0;
  }

  #print "extra_build_dir: @extra_dirs\n";

  # -------------------------------------------------------
  # Build cross product of "paths * extra_build_dirs"
  # -------------------------------------------------------
  push(@paths, map { my $path= $_;
		     map  { "$path/$_" } @extra_dirs
		   } @paths);
  #print "paths: @paths\n";

  # -------------------------------------------------------
  # Build cross product of "paths * names"
  # -------------------------------------------------------
  @paths= map { my $path= $_;
		map  { "$path/$_" } @names
	      } @paths;
  #print "paths: @paths\n";

  # -------------------------------------------------------
  # Prepend base to all paths
  # -------------------------------------------------------
  @paths= map { "$base/$_" } @paths;
  #print "paths: @paths\n";

  # -------------------------------------------------------
  # Glob all paths to expand wildcards
  # -------------------------------------------------------
  @paths= map { glob("$_") } @paths;
  #print "paths: @paths\n";

  # -------------------------------------------------------
  # Return the list of paths
  # -------------------------------------------------------
  return @paths;
}


sub commify {
  return
    (@_ == 0) ? '' :
      (@_ == 1) ? $_[0] :
	(@_ == 2) ? join(" or ", @_) :
	  join(", ", @_[0..($#_-1)], "or $_[-1]");

}


sub fnuttify {
  return map('\''.$_.'\'', @_);
}


sub find_error {
  my ($base, $paths, $names)= @_;

  my (@names, @paths);
  push(@names, ref $names eq "ARRAY" ? @$names : $names);
  push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);

  croak "** ERROR: Could not find ",
    commify(fnuttify(@names)), " in ",
      commify(fnuttify(my_find_paths($base, $paths, $names))), "\n";
}

1;