← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to mysql-test/lib/mtr_misc.pl

  • Committer: brian
  • Date: 2008-06-25 05:29:13 UTC
  • Revision ID: brian@localhost.localdomain-20080625052913-6upwo0jsrl4lnapl
clean slate

Show diffs side-by-side

added added

removed removed

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