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

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

# -*- cperl -*-
#
# Copyright (C) 2008
# 
# 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,
# WITHOUT ANY WARRANTY; without even the implied warranty of
# 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 */

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 --
1971.2.1 by kalebral at gmail update files that did not have license or had incorrect license structure	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 */
1 by brian clean slate	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;