← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to mysql-test/lib/My/Config.pm

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