# -*- cperl -*- # Copyright (c) 2007, 2010, Oracle and/or its affiliates # # 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, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY 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; use Carp; 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}; } sub option { my ($self)= @_; my $name= $self->{name}; my $value= $self->{value}; my $opt= $name; $opt= "$name=$value" if (defined $value); $opt= "--$opt" unless ($opt =~ /^--/); return $opt; } package My::Config::Group; use strict; use warnings; use Carp; 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 { $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 croak; # 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}; } sub suffix { my ($self)= @_; # Everything in name from the last . my @parts= split(/\./, $self->{name}); my $suffix= pop(@parts); return ".$suffix"; } sub after { my ($self, $prefix)= @_; die unless defined $prefix; # everything after $prefix my $name= $self->{name}; if ($name =~ /^\Q$prefix\E(.*)$/) { return $1; } die "Failed to extract the value after '$prefix' in $name"; } sub split { my ($self)= @_; # Return an array with name parts return split(/\./, $self->{name}); } # # Return a specific option in the group # sub option { my ($self, $option_name)= @_; return $self->{options_by_name}->{$option_name}; } # # Return value for an option in the group, fail if it does not exist # sub value { my ($self, $option_name)= @_; my $option= $self->option($option_name); croak "No option named '$option_name' in group '$self->{name}'" if ! defined($option); return $option->value(); } # # Return value for an option if it exist # sub if_exist { my ($self, $option_name)= @_; my $option= $self->option($option_name); return undef if ! defined($option); return $option->value(); } package My::Config::Group::ENV; our @ISA=qw(My::Config::Group); use strict; use warnings; use Carp; sub new { my ($class, $group_name)= @_; bless My::Config::Group->new($group_name), $class; } # # Return value for an option in the group, fail if it does not exist # sub value { my ($self, $option_name)= @_; my $option= $self->option($option_name); if (! defined($option) and defined $ENV{$option_name}) { my $value= $ENV{$option_name}; $option= My::Config::Option->new($option_name, $value); } croak "No option named '$option_name' in group '$self->{name}'" if ! defined($option); return $option->value(); } package My::Config::Group::OPT; our @ISA=qw(My::Config::Group); use strict; use warnings; use Carp; sub new { my ($class, $group_name)= @_; bless My::Config::Group->new($group_name), $class; } sub options { my ($self)= @_; () } sub value { my ($self, $option_name)= @_; my $option= $self->option($option_name); croak "No option named '$option_name' in group '$self->{name}'" if ! defined($option); return $option->value()->(); } package My::Config; use strict; use warnings; use Carp; 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 => [ My::Config::Group::ENV->new('ENV'), My::Config::Group::OPT->new('OPT'), ] }, $class; my $F= IO::File->new($path, "<") or croak "Could not open '$path': $!"; while ( my $line= <$F> ) { chomp($line); # Remove any trailing CR from Windows edited files $line=~ s/\cM$//; # [group] if ( $line =~ /^\[(.*)\]/ ) { # New group found $group_name= $1; #print "group: $group_name\n"; $self->insert($group_name, undef, undef); } # Magic #! comments elsif ( $line =~ /^(#\!\S+)(?:\s*(.*?)\s*)?$/) { my ($magic, $arg)= ($1, $2); croak "Found magic comment '$magic' outside of group" unless $group_name; #print "$magic\n"; $self->insert($group_name, $magic, $arg); } # Empty lines elsif ( $line =~ /^$/ ) { # Skip empty lines next; } # !include elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) { my $include_file_name= dirname($path)."/".$1; # Check that the file exists relative to path of first config file if (! -f $include_file_name){ # Try to include file relativ to current dir $include_file_name= $1; } croak "The include file '$include_file_name' does not exist" unless -f $include_file_name; $self->append(My::Config->new($include_file_name)); } #