← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to mysql-test/lib/mtr_io.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_io.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
 
 
23
sub mtr_get_pid_from_file ($);
 
24
sub mtr_get_opts_from_file ($);
 
25
sub mtr_fromfile ($);
 
26
sub mtr_tofile ($@);
 
27
sub mtr_tonewfile($@);
 
28
sub mtr_lastlinefromfile($);
 
29
sub mtr_appendfile_to_file ($$);
 
30
sub mtr_grab_file($);
 
31
 
 
32
 
 
33
##############################################################################
 
34
#
 
35
#  
 
36
#
 
37
##############################################################################
 
38
 
 
39
sub mtr_get_pid_from_file ($) {
 
40
  my $pid_file_path=  shift;
 
41
  my $TOTAL_ATTEMPTS= 30;
 
42
  my $timeout= 1;
 
43
 
 
44
  # We should read from the file until we get correct pid. As it is
 
45
  # stated in BUG#21884, pid file can be empty at some moment. So, we should
 
46
  # read it until we get valid data.
 
47
 
 
48
  for (my $cur_attempt= 1; $cur_attempt <= $TOTAL_ATTEMPTS; ++$cur_attempt)
 
49
  {
 
50
    mtr_debug("Reading pid file '$pid_file_path' " .
 
51
              "($cur_attempt of $TOTAL_ATTEMPTS)...");
 
52
 
 
53
    open(FILE, '<', $pid_file_path)
 
54
      or mtr_error("can't open file \"$pid_file_path\": $!");
 
55
 
 
56
    # Read pid number from file
 
57
    my $pid= <FILE>;
 
58
    chomp $pid;
 
59
    close FILE;
 
60
 
 
61
    return $pid if $pid=~ /^(\d+)/;
 
62
 
 
63
    mtr_debug("Pid file '$pid_file_path' does not yet contain pid number.\n" .
 
64
              "Sleeping $timeout second(s) more...");
 
65
 
 
66
    sleep($timeout);
 
67
  }
 
68
 
 
69
  mtr_error("Pid file '$pid_file_path' is corrupted. " .
 
70
            "Can not retrieve PID in " .
 
71
            ($timeout * $TOTAL_ATTEMPTS) . " seconds.");
 
72
}
 
73
 
 
74
sub mtr_get_opts_from_file ($) {
 
75
  my $file=  shift;
 
76
 
 
77
  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
 
78
  my @args;
 
79
  while ( <FILE> )
 
80
  {
 
81
    chomp;
 
82
 
 
83
    #    --set-variable=init_connect=set @a='a\\0c'
 
84
    s/^\s+//;                           # Remove leading space
 
85
    s/\s+$//;                           # Remove ending space
 
86
 
 
87
    # This is strange, but we need to fill whitespace inside
 
88
    # quotes with something, to remove later. We do this to
 
89
    # be able to split on space. Else, we have trouble with
 
90
    # options like 
 
91
    #
 
92
    #   --someopt="--insideopt1 --insideopt2"
 
93
    #
 
94
    # But still with this, we are not 100% sure it is right,
 
95
    # we need a shell to do it right.
 
96
 
 
97
#    print STDERR "\n";
 
98
#    print STDERR "AAA: $_\n";
 
99
 
 
100
    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
 
101
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
 
102
    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
 
103
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
 
104
 
 
105
#    print STDERR "BBB: $_\n";
 
106
 
 
107
#    foreach my $arg (/(--?\w.*?)(?=\s+--?\w|$)/)
 
108
 
 
109
    # FIXME ENV vars should be expanded!!!!
 
110
 
 
111
    foreach my $arg (split(/[ \t]+/))
 
112
    {
 
113
      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
 
114
      # The outermost quotes has to go
 
115
      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
 
116
        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
 
117
      $arg =~ s/\\\\/\\/g;
 
118
 
 
119
      $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge;
 
120
      $arg =~ s/\$(\w+)/envsubst($1)/ge;
 
121
 
 
122
#      print STDERR "ARG: $arg\n";
 
123
      # Do not pass empty string since my_getopt is not capable to handle it.
 
124
      if (length($arg))
 
125
      {
 
126
        push(@args, $arg)
 
127
      }
 
128
    }
 
129
  }
 
130
  close FILE;
 
131
  return \@args;
 
132
}
 
133
 
 
134
sub envsubst {
 
135
  my $string= shift;
 
136
 
 
137
  if ( ! defined $ENV{$string} )
 
138
  {
 
139
    mtr_error("opt file referense \$$string that is unknown");
 
140
  }
 
141
 
 
142
  return $ENV{$string};
 
143
}
 
144
 
 
145
sub unspace {
 
146
  my $string= shift;
 
147
  my $quote=  shift;
 
148
  $string =~ s/[ \t]/\x11/g;
 
149
  return "$quote$string$quote";
 
150
}
 
151
 
 
152
# Read a whole file, stripping leading and trailing whitespace.
 
153
sub mtr_fromfile ($) {
 
154
  my $file=  shift;
 
155
 
 
156
  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
 
157
  my $text= join('', <FILE>);
 
158
  close FILE;
 
159
  $text =~ s/^\s+//;                    # Remove starting space, incl newlines
 
160
  $text =~ s/\s+$//;                    # Remove ending space, incl newlines
 
161
  return $text;
 
162
}
 
163
 
 
164
sub mtr_lastlinefromfile ($) {
 
165
  my $file=  shift;
 
166
  my $text;
 
167
 
 
168
  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
 
169
  while (my $line= <FILE>)
 
170
  {
 
171
    $text= $line;
 
172
  }
 
173
  close FILE;
 
174
  return $text;
 
175
}
 
176
 
 
177
 
 
178
sub mtr_tofile ($@) {
 
179
  my $file=  shift;
 
180
 
 
181
  open(FILE,">>",$file) or mtr_error("can't open file \"$file\": $!");
 
182
  print FILE join("", @_);
 
183
  close FILE;
 
184
}
 
185
 
 
186
sub mtr_tonewfile ($@) {
 
187
  my $file=  shift;
 
188
 
 
189
  open(FILE,">",$file) or mtr_error("can't open file \"$file\": $!");
 
190
  print FILE join("", @_);
 
191
  close FILE;
 
192
}
 
193
 
 
194
sub mtr_appendfile_to_file ($$) {
 
195
  my $from_file=  shift;
 
196
  my $to_file=  shift;
 
197
 
 
198
  open(TOFILE,">>",$to_file) or mtr_error("can't open file \"$to_file\": $!");
 
199
  open(FROMFILE,"<",$from_file)
 
200
    or mtr_error("can't open file \"$from_file\": $!");
 
201
  print TOFILE while (<FROMFILE>);
 
202
  close FROMFILE;
 
203
  close TOFILE;
 
204
}
 
205
 
 
206
# Read a whole file verbatim.
 
207
sub mtr_grab_file($) {
 
208
  my $file= shift;
 
209
  open(FILE, '<', $file)
 
210
    or return undef;
 
211
  local $/= undef;
 
212
  my $data= scalar(<FILE>);
 
213
  close FILE;
 
214
  return $data;
 
215
}
 
216
 
 
217
 
 
218
1;