~drizzle-trunk/drizzle/development : contents of tests/lib/My/Config.pm at revision 1841

~drizzle-trunk/drizzle/development : (revision 1841)

# -*- cperl -*-

package My::Config::Option;

use strict;
use warnings;


sub new {
  my ($class, $option_name, $option_value)= @_;
  my $self= bless { name => $option_name,
		    value => $option_value
		  }, $class;
  return $self;
}


sub name {
  my ($self)= @_;
  return $self->{name};
}


sub value {
  my ($self)= @_;
  return $self->{value};
}


package My::Config::Group;

use strict;
use warnings;


sub new {
  my ($class, $group_name)= @_;
  my $self= bless { name => $group_name,
		    options => [],
		    options_by_name => {},
		  }, $class;
  return $self;
}


sub insert {
  my ($self, $option_name, $value, $if_not_exist)= @_;
  my $option= $self->option($option_name);
  if (defined($option) and !$if_not_exist) {
    $option->{value}= $value;
  }
  else {
    my $option= My::Config::Option->new($option_name, $value);
    # Insert option in list
    push(@{$self->{options}}, $option);
    # Insert option in hash
    $self->{options_by_name}->{$option_name}= $option;
  }
  return $option;
}

sub remove {
  my ($self, $option_name)= @_;

  # Check that option exists
  my $option= $self->option($option_name);

  return undef unless defined $option;

  # Remove from the hash
  delete($self->{options_by_name}->{$option_name}) or die;

  # Remove from the array
  @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}};

  return $option;
}


sub options {
  my ($self)= @_;
  return @{$self->{options}};
}


sub name {
  my ($self)= @_;
  return $self->{name};
}


#
# Return a specific option in the group
#
sub option {
  my ($self, $option_name)= @_;

  return $self->{options_by_name}->{$option_name};
}


#
# Return a specific value for an option in the group
#
sub value {
  my ($self, $option_name)= @_;
  my $option= $self->option($option_name);

  die "No option named '$option_name' in this group"
    if ! defined($option);

  return $option->value();
}


package My::Config;

use strict;
use warnings;
use IO::File;
use File::Basename;

#
# Constructor for My::Config
# - represents a my.cnf config file
#
# Array of arrays
#
sub new {
  my ($class, $path)= @_;
  my $group_name= undef;

  my $self= bless { groups => [] }, $class;
  my $F= IO::File->new($path, "<")
    or die "Could not open '$path': $!";

  while (  my $line= <$F> ) {
    chomp($line);

    # [group]
    if ( $line =~ /\[(.*)\]/ ) {
      # New group found
      $group_name= $1;
      #print "group: $group_name\n";

      $self->insert($group_name, undef, undef);
    }

    # Magic #! comments
    elsif ( $line =~ /^#\!/) {
      my $magic= $line;
      die "Found magic comment '$magic' outside of group"
	unless $group_name;

      #print "$magic\n";
      $self->insert($group_name, $magic, undef);
    }

    # Comments
    elsif ( $line =~ /^#/ || $line =~ /^;/) {
      # Skip comment
      next;
    }

    # Empty lines
    elsif ( $line =~ /^$/ ) {
      # Skip empty lines
      next;
    }

    # !include <filename>
    elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) {
      my $include_file_name= dirname($path)."/".$1;
      # Check that the file exists
      die "The include file '$include_file_name' does not exist"
	unless -f $include_file_name;

      $self->append(My::Config->new($include_file_name));
    }

    # <option>
    elsif ( $line =~ /^([\@\w-]+)\s*$/ ) {
      my $option= $1;

      die "Found option '$option' outside of group"
	unless $group_name;

      #print "$option\n";
      $self->insert($group_name, $option, undef);
    }

    # <option>=<value>
    elsif ( $line =~ /^([\@\w-]+)\s*=\s*(.*?)\s*$/ ) {
      my $option= $1;
      my $value= $2;

      die "Found option '$option=$value' outside of group"
	unless $group_name;

      #print "$option=$value\n";
      $self->insert($group_name, $option, $value);
    } else {
      die "Unexpected line '$line' found in '$path'";
    }

  }
  undef $F;			# Close the file

  return $self;
}

#
# Insert a new group if it does not already exist
# and add option if defined
#
sub insert {
  my ($self, $group_name, $option, $value, $if_not_exist)= @_;
  my $group;

  # Create empty array for the group if it doesn't exist
  if ( !$self->group_exists($group_name) ) {
    $group= $self->_group_insert($group_name);
  }
  else {
    $group= $self->group($group_name);
  }

  if ( defined $option ) {
    #print "option: $option, value: $value\n";

    # Add the option to the group
    $group->insert($option, $value, $if_not_exist);
  }
}

#
# Remove a option, given group and option name
#
sub remove {
  my ($self, $group_name, $option_name)= @_;
  my $group= $self->group($group_name);

  die "group '$group_name' does not exist"
    unless defined($group);

  $group->remove($option_name) or
    die "option '$option_name' does not exist";
}



#
# Check if group with given name exists in config
#
sub group_exists {
  my ($self, $group_name)= @_;

  foreach my $group ($self->groups()) {
    return 1 if $group->{name} eq $group_name;
  }
  return 0;
}


#
# Insert a new group into config
#
sub _group_insert {
  my ($self, $group_name)= @_;
  caller eq __PACKAGE__ or die;

  # Check that group does not already exist
  die "Group already exists" if $self->group_exists($group_name);

  my $group= My::Config::Group->new($group_name);
  push(@{$self->{groups}}, $group);
  return $group;
}


#
# Append a configuration to current config
#
sub append {
  my ($self, $from)= @_;

  foreach my $group ($from->groups()) {
    foreach my $option ($group->options()) {
      $self->insert($group->name(), $option->name(), $option->value());
    }

  }
}


#
# Return a list with all the groups in config
#
sub groups {
  my ($self)= @_;
  return ( @{$self->{groups}} );
}


#
# Return a list of all the groups in config
# starting with the given string
#
sub like {
  my ($self, $prefix)= @_;
  return ( grep ( $_->{name} =~ /^$prefix/, $self->groups()) );
}


#
# Return the first group in config
# starting with the given string
#
sub first_like {
  my ($self, $prefix)= @_;
  return ($self->like($prefix))[0];
}


#
# Return a specific group in the config
#
sub group {
  my ($self, $group_name)= @_;

  foreach my $group ( $self->groups() ) {
    return $group if $group->{name} eq $group_name;
  }
  return undef;
}


#
# Return a list of all options in a specific group in the config
#
sub options_in_group {
  my ($self, $group_name)= @_;

  my $group= $self->group($group_name);
  return () unless defined $group;
  return $group->options();
}


#
# Return a value given group and option name
#
sub value {
  my ($self, $group_name, $option_name)= @_;
  my $group= $self->group($group_name);

  die "group '$group_name' does not exist"
    unless defined($group);

  my $option= $group->option($option_name);
  die "option '$option_name' does not exist"
    unless defined($option);

  return $option->value();
}


#
# Check if an option exists
#
sub exists {
  my ($self, $group_name, $option_name)= @_;
  my $group= $self->group($group_name);

  die "group '$group_name' does not exist"
    unless defined($group);

  my $option= $group->option($option_name);
  return defined($option);
}


# Overload "to string"-operator with 'stringify'
use overload
    '""' => \&stringify;

#
# Return the config as a string in my.cnf file format
#
sub stringify {
  my ($self)= @_;
  my $res;

  foreach my $group ($self->groups()) {
    $res .= "[$group->{name}]\n";

    foreach my $option ($group->options()) {
      $res .= $option->name();
      my $value= $option->value();
      if (defined $value) {
	$res .= "=$value";
      }
      $res .= "\n";
    }
    $res .= "\n";
  }
  return $res;
}


#
# Save the config to named file
#
sub save {
    my ($self, $path)= @_;
    my $F= IO::File->new($path, ">")
	or die "Could not open '$path': $!";
    print $F $self;
    undef $F; # Close the file
}

1;

1 by brian clean slate	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;