← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/lib/My/Config.pm

  • Committer: Stewart Smith
  • Date: 2010-02-22 07:44:37 UTC
  • mfrom: (1283.17.4)
  • mto: (1283.19.1)
  • mto: This revision was merged to the branch mainline in revision 1449.
  • Revision ID: stewart@flamingspork.com-20100222074437-1a9x1n030tbtv1qv
Merged embeddded-innodb-store-table-proto into embedded-innodb-write-row.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lib/My/Config.pm
1
 
# -*- cperl -*-
2
 
#
3
 
# Copyright (C) 2008
4
 
# 
5
 
# This program is free software; you can redistribute it and/or modify
6
 
# it under the terms of the GNU General Public License as published by
7
 
# the Free Software Foundation; version 2 of the License.
8
 
# 
9
 
# This program is distributed in the hope that it will be useful,
10
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
# or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
 
# GNU General Public License for more details.
13
 
# 
14
 
# You should have received a copy of the GNU General Public License
15
 
# along with this program; if not, write to the Free Software
16
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA */
17
 
 
18
 
package My::Config::Option;
19
 
 
20
 
use strict;
21
 
use warnings;
22
 
 
23
 
 
24
 
sub new {
25
 
  my ($class, $option_name, $option_value)= @_;
26
 
  my $self= bless { name => $option_name,
27
 
                    value => $option_value
28
 
                  }, $class;
29
 
  return $self;
30
 
}
31
 
 
32
 
 
33
 
sub name {
34
 
  my ($self)= @_;
35
 
  return $self->{name};
36
 
}
37
 
 
38
 
 
39
 
sub value {
40
 
  my ($self)= @_;
41
 
  return $self->{value};
42
 
}
43
 
 
44
 
 
45
 
package My::Config::Group;
46
 
 
47
 
use strict;
48
 
use warnings;
49
 
 
50
 
 
51
 
sub new {
52
 
  my ($class, $group_name)= @_;
53
 
  my $self= bless { name => $group_name,
54
 
                    options => [],
55
 
                    options_by_name => {},
56
 
                  }, $class;
57
 
  return $self;
58
 
}
59
 
 
60
 
 
61
 
sub insert {
62
 
  my ($self, $option_name, $value, $if_not_exist)= @_;
63
 
  my $option= $self->option($option_name);
64
 
  if (defined($option) and !$if_not_exist) {
65
 
    $option->{value}= $value;
66
 
  }
67
 
  else {
68
 
    my $option= My::Config::Option->new($option_name, $value);
69
 
    # Insert option in list
70
 
    push(@{$self->{options}}, $option);
71
 
    # Insert option in hash
72
 
    $self->{options_by_name}->{$option_name}= $option;
73
 
  }
74
 
  return $option;
75
 
}
76
 
 
77
 
sub remove {
78
 
  my ($self, $option_name)= @_;
79
 
 
80
 
  # Check that option exists
81
 
  my $option= $self->option($option_name);
82
 
 
83
 
  return undef unless defined $option;
84
 
 
85
 
  # Remove from the hash
86
 
  delete($self->{options_by_name}->{$option_name}) or die;
87
 
 
88
 
  # Remove from the array
89
 
  @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}};
90
 
 
91
 
  return $option;
92
 
}
93
 
 
94
 
 
95
 
sub options {
96
 
  my ($self)= @_;
97
 
  return @{$self->{options}};
98
 
}
99
 
 
100
 
 
101
 
sub name {
102
 
  my ($self)= @_;
103
 
  return $self->{name};
104
 
}
105
 
 
106
 
 
107
 
#
108
 
# Return a specific option in the group
109
 
#
110
 
sub option {
111
 
  my ($self, $option_name)= @_;
112
 
 
113
 
  return $self->{options_by_name}->{$option_name};
114
 
}
115
 
 
116
 
 
117
 
#
118
 
# Return a specific value for an option in the group
119
 
#
120
 
sub value {
121
 
  my ($self, $option_name)= @_;
122
 
  my $option= $self->option($option_name);
123
 
 
124
 
  die "No option named '$option_name' in this group"
125
 
    if ! defined($option);
126
 
 
127
 
  return $option->value();
128
 
}
129
 
 
130
 
 
131
 
package My::Config;
132
 
 
133
 
use strict;
134
 
use warnings;
135
 
use IO::File;
136
 
use File::Basename;
137
 
 
138
 
#
139
 
# Constructor for My::Config
140
 
# - represents a my.cnf config file
141
 
#
142
 
# Array of arrays
143
 
#
144
 
sub new {
145
 
  my ($class, $path)= @_;
146
 
  my $group_name= undef;
147
 
 
148
 
  my $self= bless { groups => [] }, $class;
149
 
  my $F= IO::File->new($path, "<")
150
 
    or die "Could not open '$path': $!";
151
 
 
152
 
  while (  my $line= <$F> ) {
153
 
    chomp($line);
154
 
 
155
 
    # [group]
156
 
    if ( $line =~ /\[(.*)\]/ ) {
157
 
      # New group found
158
 
      $group_name= $1;
159
 
      #print "group: $group_name\n";
160
 
 
161
 
      $self->insert($group_name, undef, undef);
162
 
    }
163
 
 
164
 
    # Magic #! comments
165
 
    elsif ( $line =~ /^#\!/) {
166
 
      my $magic= $line;
167
 
      die "Found magic comment '$magic' outside of group"
168
 
        unless $group_name;
169
 
 
170
 
      #print "$magic\n";
171
 
      $self->insert($group_name, $magic, undef);
172
 
    }
173
 
 
174
 
    # Comments
175
 
    elsif ( $line =~ /^#/ || $line =~ /^;/) {
176
 
      # Skip comment
177
 
      next;
178
 
    }
179
 
 
180
 
    # Empty lines
181
 
    elsif ( $line =~ /^$/ ) {
182
 
      # Skip empty lines
183
 
      next;
184
 
    }
185
 
 
186
 
    # !include <filename>
187
 
    elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) {
188
 
      my $include_file_name= dirname($path)."/".$1;
189
 
      # Check that the file exists
190
 
      die "The include file '$include_file_name' does not exist"
191
 
        unless -f $include_file_name;
192
 
 
193
 
      $self->append(My::Config->new($include_file_name));
194
 
    }
195
 
 
196
 
    # <option>
197
 
    elsif ( $line =~ /^([\@\w-]+)\s*$/ ) {
198
 
      my $option= $1;
199
 
 
200
 
      die "Found option '$option' outside of group"
201
 
        unless $group_name;
202
 
 
203
 
      #print "$option\n";
204
 
      $self->insert($group_name, $option, undef);
205
 
    }
206
 
 
207
 
    # <option>=<value>
208
 
    elsif ( $line =~ /^([\@\w-]+)\s*=\s*(.*?)\s*$/ ) {
209
 
      my $option= $1;
210
 
      my $value= $2;
211
 
 
212
 
      die "Found option '$option=$value' outside of group"
213
 
        unless $group_name;
214
 
 
215
 
      #print "$option=$value\n";
216
 
      $self->insert($group_name, $option, $value);
217
 
    } else {
218
 
      die "Unexpected line '$line' found in '$path'";
219
 
    }
220
 
 
221
 
  }
222
 
  undef $F;                     # Close the file
223
 
 
224
 
  return $self;
225
 
}
226
 
 
227
 
#
228
 
# Insert a new group if it does not already exist
229
 
# and add option if defined
230
 
#
231
 
sub insert {
232
 
  my ($self, $group_name, $option, $value, $if_not_exist)= @_;
233
 
  my $group;
234
 
 
235
 
  # Create empty array for the group if it doesn't exist
236
 
  if ( !$self->group_exists($group_name) ) {
237
 
    $group= $self->_group_insert($group_name);
238
 
  }
239
 
  else {
240
 
    $group= $self->group($group_name);
241
 
  }
242
 
 
243
 
  if ( defined $option ) {
244
 
    #print "option: $option, value: $value\n";
245
 
 
246
 
    # Add the option to the group
247
 
    $group->insert($option, $value, $if_not_exist);
248
 
  }
249
 
}
250
 
 
251
 
#
252
 
# Remove a option, given group and option name
253
 
#
254
 
sub remove {
255
 
  my ($self, $group_name, $option_name)= @_;
256
 
  my $group= $self->group($group_name);
257
 
 
258
 
  die "group '$group_name' does not exist"
259
 
    unless defined($group);
260
 
 
261
 
  $group->remove($option_name) or
262
 
    die "option '$option_name' does not exist";
263
 
}
264
 
 
265
 
 
266
 
 
267
 
#
268
 
# Check if group with given name exists in config
269
 
#
270
 
sub group_exists {
271
 
  my ($self, $group_name)= @_;
272
 
 
273
 
  foreach my $group ($self->groups()) {
274
 
    return 1 if $group->{name} eq $group_name;
275
 
  }
276
 
  return 0;
277
 
}
278
 
 
279
 
 
280
 
#
281
 
# Insert a new group into config
282
 
#
283
 
sub _group_insert {
284
 
  my ($self, $group_name)= @_;
285
 
  caller eq __PACKAGE__ or die;
286
 
 
287
 
  # Check that group does not already exist
288
 
  die "Group already exists" if $self->group_exists($group_name);
289
 
 
290
 
  my $group= My::Config::Group->new($group_name);
291
 
  push(@{$self->{groups}}, $group);
292
 
  return $group;
293
 
}
294
 
 
295
 
 
296
 
#
297
 
# Append a configuration to current config
298
 
#
299
 
sub append {
300
 
  my ($self, $from)= @_;
301
 
 
302
 
  foreach my $group ($from->groups()) {
303
 
    foreach my $option ($group->options()) {
304
 
      $self->insert($group->name(), $option->name(), $option->value());
305
 
    }
306
 
 
307
 
  }
308
 
}
309
 
 
310
 
 
311
 
#
312
 
# Return a list with all the groups in config
313
 
#
314
 
sub groups {
315
 
  my ($self)= @_;
316
 
  return ( @{$self->{groups}} );
317
 
}
318
 
 
319
 
 
320
 
#
321
 
# Return a list of all the groups in config
322
 
# starting with the given string
323
 
#
324
 
sub like {
325
 
  my ($self, $prefix)= @_;
326
 
  return ( grep ( $_->{name} =~ /^$prefix/, $self->groups()) );
327
 
}
328
 
 
329
 
 
330
 
#
331
 
# Return the first group in config
332
 
# starting with the given string
333
 
#
334
 
sub first_like {
335
 
  my ($self, $prefix)= @_;
336
 
  return ($self->like($prefix))[0];
337
 
}
338
 
 
339
 
 
340
 
#
341
 
# Return a specific group in the config
342
 
#
343
 
sub group {
344
 
  my ($self, $group_name)= @_;
345
 
 
346
 
  foreach my $group ( $self->groups() ) {
347
 
    return $group if $group->{name} eq $group_name;
348
 
  }
349
 
  return undef;
350
 
}
351
 
 
352
 
 
353
 
#
354
 
# Return a list of all options in a specific group in the config
355
 
#
356
 
sub options_in_group {
357
 
  my ($self, $group_name)= @_;
358
 
 
359
 
  my $group= $self->group($group_name);
360
 
  return () unless defined $group;
361
 
  return $group->options();
362
 
}
363
 
 
364
 
 
365
 
#
366
 
# Return a value given group and option name
367
 
#
368
 
sub value {
369
 
  my ($self, $group_name, $option_name)= @_;
370
 
  my $group= $self->group($group_name);
371
 
 
372
 
  die "group '$group_name' does not exist"
373
 
    unless defined($group);
374
 
 
375
 
  my $option= $group->option($option_name);
376
 
  die "option '$option_name' does not exist"
377
 
    unless defined($option);
378
 
 
379
 
  return $option->value();
380
 
}
381
 
 
382
 
 
383
 
#
384
 
# Check if an option exists
385
 
#
386
 
sub exists {
387
 
  my ($self, $group_name, $option_name)= @_;
388
 
  my $group= $self->group($group_name);
389
 
 
390
 
  die "group '$group_name' does not exist"
391
 
    unless defined($group);
392
 
 
393
 
  my $option= $group->option($option_name);
394
 
  return defined($option);
395
 
}
396
 
 
397
 
 
398
 
# Overload "to string"-operator with 'stringify'
399
 
use overload
400
 
    '""' => \&stringify;
401
 
 
402
 
#
403
 
# Return the config as a string in my.cnf file format
404
 
#
405
 
sub stringify {
406
 
  my ($self)= @_;
407
 
  my $res;
408
 
 
409
 
  foreach my $group ($self->groups()) {
410
 
    $res .= "[$group->{name}]\n";
411
 
 
412
 
    foreach my $option ($group->options()) {
413
 
      $res .= $option->name();
414
 
      my $value= $option->value();
415
 
      if (defined $value) {
416
 
        $res .= "=$value";
417
 
      }
418
 
      $res .= "\n";
419
 
    }
420
 
    $res .= "\n";
421
 
  }
422
 
  return $res;
423
 
}
424
 
 
425
 
 
426
 
#
427
 
# Save the config to named file
428
 
#
429
 
sub save {
430
 
    my ($self, $path)= @_;
431
 
    my $F= IO::File->new($path, ">")
432
 
        or die "Could not open '$path': $!";
433
 
    print $F $self;
434
 
    undef $F; # Close the file
435
 
}
436
 
 
437
 
1;