1# -*- cperl -*-
2# Copyright (c) 2004, 2010, Oracle and/or its affiliates. All rights reserved.
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License, version 2.0,
6# as published by the Free Software Foundation.
7#
8# This program is also distributed with certain software (including
9# but not limited to OpenSSL) that is licensed under separate terms,
10# as designated in a particular file or component or in included license
11# documentation.  The authors of MySQL hereby grant you an additional
12# permission to link the program and your derivative works with the
13# separately licensed software that they have included with MySQL.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License, version 2.0, for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
23
24# This is a library file used by the Perl version of mysql-test-run,
25# and is part of the translation of the Bourne shell script with the
26# same name.
27
28use strict;
29use File::Find;
30
31sub mtr_native_path($);
32sub mtr_init_args ($);
33sub mtr_add_arg ($$@);
34sub mtr_path_exists(@);
35sub mtr_script_exists(@);
36sub mtr_file_exists(@);
37sub mtr_exe_exists(@);
38sub mtr_exe_maybe_exists(@);
39sub mtr_copy_dir($$);
40sub mtr_rmtree($);
41sub mtr_same_opts($$);
42sub mtr_cmp_opts($$);
43
44##############################################################################
45#
46#  Misc
47#
48##############################################################################
49
50# Convert path to OS native format
51sub mtr_native_path($)
52{
53  my $path= shift;
54
55  # MySQL version before 5.0 still use cygwin, no need
56  # to convert path
57  return $path
58    if ($::mysql_version_id < 50000);
59
60  $path=~ s/\//\\/g
61    if ($::glob_win32);
62  return $path;
63}
64
65
66# FIXME move to own lib
67
68sub mtr_init_args ($) {
69  my $args = shift;
70  $$args = [];                            # Empty list
71}
72
73sub mtr_add_arg ($$@) {
74  my $args=   shift;
75  my $format= shift;
76  my @fargs = @_;
77
78  push(@$args, sprintf($format, @fargs));
79}
80
81##############################################################################
82
83#
84# NOTE! More specific paths should be given before less specific.
85# For example /client/debug should be listed before /client
86#
87sub mtr_path_exists (@) {
88  foreach my $path ( @_ )
89  {
90    return $path if -e $path;
91  }
92  if ( @_ == 1 )
93  {
94    mtr_error("Could not find $_[0]");
95  }
96  else
97  {
98    mtr_error("Could not find any of " . join(" ", @_));
99  }
100}
101
102
103#
104# NOTE! More specific paths should be given before less specific.
105# For example /client/debug should be listed before /client
106#
107sub mtr_script_exists (@) {
108  foreach my $path ( @_ )
109  {
110    if($::glob_win32)
111    {
112      return $path if -f $path;
113    }
114    else
115    {
116      return $path if -x $path;
117    }
118  }
119  if ( @_ == 1 )
120  {
121    mtr_error("Could not find $_[0]");
122  }
123  else
124  {
125    mtr_error("Could not find any of " . join(" ", @_));
126  }
127}
128
129
130#
131# NOTE! More specific paths should be given before less specific.
132# For example /client/debug should be listed before /client
133#
134sub mtr_file_exists (@) {
135  foreach my $path ( @_ )
136  {
137    return $path if -e $path;
138  }
139  return "";
140}
141
142
143#
144# NOTE! More specific paths should be given before less specific.
145# For example /client/debug should be listed before /client
146#
147sub mtr_exe_maybe_exists (@) {
148  my @path= @_;
149
150  map {$_.= ".exe"} @path if $::glob_win32;
151  foreach my $path ( @path )
152  {
153    if($::glob_win32)
154    {
155      return $path if -f $path;
156    }
157    else
158    {
159      return $path if -x $path;
160    }
161  }
162  return "";
163}
164
165
166#
167# NOTE! More specific paths should be given before less specific.
168# For example /client/debug should be listed before /client
169#
170sub mtr_exe_exists (@) {
171  my @path= @_;
172  if (my $path= mtr_exe_maybe_exists(@path))
173  {
174    return $path;
175  }
176  # Could not find exe, show error
177  if ( @path == 1 )
178  {
179    mtr_error("Could not find $path[0]");
180  }
181  else
182  {
183    mtr_error("Could not find any of " . join(" ", @path));
184  }
185}
186
187
188sub mtr_copy_dir($$) {
189  my $from_dir= shift;
190  my $to_dir= shift;
191
192  # mtr_verbose("Copying from $from_dir to $to_dir");
193
194  mkpath("$to_dir");
195  opendir(DIR, "$from_dir")
196    or mtr_error("Can't find $from_dir$!");
197  for(readdir(DIR)) {
198    next if "$_" eq "." or "$_" eq "..";
199    if ( -d "$from_dir/$_" )
200    {
201      mtr_copy_dir("$from_dir/$_", "$to_dir/$_");
202      next;
203    }
204    copy("$from_dir/$_", "$to_dir/$_");
205  }
206  closedir(DIR);
207
208}
209
210
211sub mtr_rmtree($) {
212  my ($dir)= @_;
213  mtr_verbose("mtr_rmtree: $dir");
214
215  # Try to use File::Path::rmtree. Recent versions
216  # handles removal of directories and files that don't
217  # have full permissions, while older versions
218  # may have a problem with that and we use our own version
219
220  eval { rmtree($dir); };
221  if ( $@ ) {
222    mtr_warning("rmtree($dir) failed, trying with File::Find...");
223
224    my $errors= 0;
225
226    # chmod
227    find( {
228	   no_chdir => 1,
229	   wanted => sub {
230	     chmod(0777, $_)
231	       or mtr_warning("couldn't chmod(0777, $_): $!") and $errors++;
232	   }
233	  },
234	  $dir
235	);
236
237    # rm
238    finddepth( {
239	   no_chdir => 1,
240	   wanted => sub {
241	     my $file= $_;
242	     # Use special underscore (_) filehandle, caches stat info
243	     if (!-l $file and -d _ ) {
244	       rmdir($file) or
245		 mtr_warning("couldn't rmdir($file): $!") and $errors++;
246	     } else {
247	       unlink($file)
248		 or mtr_warning("couldn't unlink($file): $!") and $errors++;
249	     }
250	   }
251	  },
252	  $dir
253	);
254
255    mtr_error("Failed to remove '$dir'") if $errors;
256
257    mtr_report("OK, that worked!");
258  }
259}
260
261
262sub mtr_same_opts ($$) {
263  my $l1= shift;
264  my $l2= shift;
265  return mtr_cmp_opts($l1,$l2) == 0;
266}
267
268sub mtr_cmp_opts ($$) {
269  my $l1= shift;
270  my $l2= shift;
271
272  my @l1= @$l1;
273  my @l2= @$l2;
274
275  return -1 if @l1 < @l2;
276  return  1 if @l1 > @l2;
277
278  while ( @l1 )                         # Same length
279  {
280    my $e1= shift @l1;
281    my $e2= shift @l2;
282    my $cmp= ($e1 cmp $e2);
283    return $cmp if $cmp != 0;
284  }
285
286  return 0;                             # They are the same
287}
288
289#
290# Compare two arrays and put all unequal elements into a new one
291#
292sub mtr_diff_opts ($$) {
293  my $l1= shift;
294  my $l2= shift;
295  my $f;
296  my $l= [];
297  foreach my $e1 (@$l1)
298  {
299    $f= undef;
300    foreach my $e2 (@$l2)
301    {
302      $f= 1 unless ($e1 ne $e2);
303    }
304    push(@$l, $e1) unless (defined $f);
305  }
306  foreach my $e2 (@$l2)
307  {
308    $f= undef;
309    foreach my $e1 (@$l1)
310    {
311      $f= 1 unless ($e1 ne $e2);
312    }
313    push(@$l, $e2) unless (defined $f);
314  }
315  return $l;
316}
317
3181;
319