summaryrefslogtreecommitdiff
path: root/mysql-test/lib/v1/mtr_io.pl
blob: ebd50ad22121bcbd85a5a484e8d8b437c551fc59 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
# -*- cperl -*-
# Copyright (c) 2004-2006 MySQL AB, 2008 Sun Microsystems, Inc.
# Use is subject to license terms.
# 
# 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

# 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;

sub mtr_get_pid_from_file ($);
sub mtr_get_opts_from_file ($);
sub mtr_fromfile ($);
sub mtr_tofile ($@);
sub mtr_tonewfile($@);
sub mtr_lastlinefromfile($);
sub mtr_appendfile_to_file ($$);
sub mtr_grab_file($);


##############################################################################
#
#  
#
##############################################################################

sub mtr_get_pid_from_file ($) {
  my $pid_file_path=  shift;
  my $TOTAL_ATTEMPTS= 30;
  my $timeout= 1;

  # We should read from the file until we get correct pid. As it is
  # stated in BUG#21884, pid file can be empty at some moment. So, we should
  # read it until we get valid data.

  for (my $cur_attempt= 1; $cur_attempt <= $TOTAL_ATTEMPTS; ++$cur_attempt)
  {
    mtr_debug("Reading pid file '$pid_file_path' " .
              "($cur_attempt of $TOTAL_ATTEMPTS)...");

    open(FILE, '<', $pid_file_path)
      or mtr_error("can't open file \"$pid_file_path\": $!");

    # Read pid number from file
    my $pid= <FILE>;
    chomp $pid;
    close FILE;

    return $pid if $pid=~ /^(\d+)/;

    mtr_debug("Pid file '$pid_file_path' does not yet contain pid number.\n" .
              "Sleeping $timeout second(s) more...");

    sleep($timeout);
  }

  mtr_error("Pid file '$pid_file_path' is corrupted. " .
            "Can not retrieve PID in " .
            ($timeout * $TOTAL_ATTEMPTS) . " seconds.");
}

sub mtr_get_opts_from_file ($) {
  my $file=  shift;

  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  my @args;
  while ( <FILE> )
  {
    chomp;

    #    --set-variable=init_connect=set @a='a\\0c'
    s/^\s+//;                           # Remove leading space
    s/\s+$//;                           # Remove ending space

    # This is strange, but we need to fill whitespace inside
    # quotes with something, to remove later. We do this to
    # be able to split on space. Else, we have trouble with
    # options like 
    #
    #   --someopt="--insideopt1 --insideopt2"
    #
    # But still with this, we are not 100% sure it is right,
    # we need a shell to do it right.

#    print STDERR "\n";
#    print STDERR "AAA: $_\n";

    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;

#    print STDERR "BBB: $_\n";

#    foreach my $arg (/(--?\w.*?)(?=\s+--?\w|$)/)

    # FIXME ENV vars should be expanded!!!!

    foreach my $arg (split(/[ \t]+/))
    {
      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
      # The outermost quotes has to go
      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
      $arg =~ s/\\\\/\\/g;

      $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge;
      $arg =~ s/\$(\w+)/envsubst($1)/ge;

#      print STDERR "ARG: $arg\n";
      # Do not pass empty string since my_getopt is not capable to handle it.
      if (length($arg))
      {
        push(@args, $arg)
      }
    }
  }
  close FILE;
  return \@args;
}

sub envsubst {
  my $string= shift;

  if ( ! defined $ENV{$string} )
  {
    mtr_error("opt file referense \$$string that is unknown");
  }

  return $ENV{$string};
}

sub unspace {
  my $string= shift;
  my $quote=  shift;
  $string =~ s/[ \t]/\x11/g;
  return "$quote$string$quote";
}

# Read a whole file, stripping leading and trailing whitespace.
sub mtr_fromfile ($) {
  my $file=  shift;

  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  my $text= join('', <FILE>);
  close FILE;
  $text =~ s/^\s+//;                    # Remove starting space, incl newlines
  $text =~ s/\s+$//;                    # Remove ending space, incl newlines
  return $text;
}

sub mtr_lastlinefromfile ($) {
  my $file=  shift;
  my $text;

  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  while (my $line= <FILE>)
  {
    $text= $line;
  }
  close FILE;
  return $text;
}


sub mtr_tofile ($@) {
  my $file=  shift;

  open(FILE,">>",$file) or mtr_error("can't open file \"$file\": $!");
  print FILE join("", @_);
  close FILE;
}

sub mtr_tonewfile ($@) {
  my $file=  shift;

  open(FILE,">",$file) or mtr_error("can't open file \"$file\": $!");
  print FILE join("", @_);
  close FILE;
}

sub mtr_appendfile_to_file ($$) {
  my $from_file=  shift;
  my $to_file=  shift;

  open(TOFILE,">>",$to_file) or mtr_error("can't open file \"$to_file\": $!");
  open(FROMFILE,"<",$from_file)
    or mtr_error("can't open file \"$from_file\": $!");
  print TOFILE while (<FROMFILE>);
  close FROMFILE;
  close TOFILE;
}

# Read a whole file verbatim.
sub mtr_grab_file($) {
  my $file= shift;
  open(FILE, '<', $file)
    or return undef;
  local $/= undef;
  my $data= scalar(<FILE>);
  close FILE;
  return $data;
}


1;