← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/lib/dtr_io.pl

  • Committer: Lee
  • Date: 2008-10-30 22:02:01 UTC
  • mto: (572.1.2 devel)
  • mto: This revision was merged to the branch mainline in revision 573.
  • Revision ID: lbieber@lbieber-desktop-20081030220201-elb6qprbzpn7c5a4
add my name to the AUTHORS file

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lib/dtr_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 drizzle-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 dtr_get_pid_from_file ($);
24
 
sub dtr_get_opts_from_file ($);
25
 
sub dtr_fromfile ($);
26
 
sub dtr_tofile ($@);
27
 
sub dtr_tonewfile($@);
28
 
sub dtr_lastlinefromfile($);
29
 
sub dtr_appendfile_to_file ($$);
30
 
sub dtr_grab_file($);
31
 
 
32
 
 
33
 
##############################################################################
34
 
#
35
 
#  
36
 
#
37
 
##############################################################################
38
 
 
39
 
sub dtr_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
 
    dtr_debug("Reading pid file '$pid_file_path' " .
51
 
              "($cur_attempt of $TOTAL_ATTEMPTS)...");
52
 
 
53
 
    open(FILE, '<', $pid_file_path)
54
 
      or dtr_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
 
    dtr_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
 
  dtr_error("Pid file '$pid_file_path' is corrupted. " .
70
 
            "Can not retrieve PID in " .
71
 
            ($timeout * $TOTAL_ATTEMPTS) . " seconds.");
72
 
}
73
 
 
74
 
sub dtr_get_opts_from_file ($) {
75
 
  my $file=  shift;
76
 
 
77
 
  open(FILE,"<",$file) or dtr_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
 
    dtr_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 dtr_fromfile ($) {
154
 
  my $file=  shift;
155
 
 
156
 
  open(FILE,"<",$file) or dtr_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 dtr_lastlinefromfile ($) {
165
 
  my $file=  shift;
166
 
  my $text;
167
 
 
168
 
  open(FILE,"<",$file) or dtr_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 dtr_tofile ($@) {
179
 
  my $file=  shift;
180
 
 
181
 
  open(FILE,">>",$file) or dtr_error("can't open file \"$file\": $!");
182
 
  print FILE join("", @_);
183
 
  close FILE;
184
 
}
185
 
 
186
 
sub dtr_tonewfile ($@) {
187
 
  my $file=  shift;
188
 
 
189
 
  open(FILE,">",$file) or dtr_error("can't open file \"$file\": $!");
190
 
  print FILE join("", @_);
191
 
  close FILE;
192
 
}
193
 
 
194
 
sub dtr_appendfile_to_file ($$) {
195
 
  my $from_file=  shift;
196
 
  my $to_file=  shift;
197
 
 
198
 
  open(TOFILE,">>",$to_file) or dtr_error("can't open file \"$to_file\": $!");
199
 
  open(FROMFILE,"<",$from_file)
200
 
    or dtr_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 dtr_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;