# -*- cperl -*- # Copyright (c) 2007, 2019, Oracle and/or its affiliates. All rights reserved. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License, version 2.0, # as published by the Free Software Foundation. # # This program is also distributed with certain software (including # but not limited to OpenSSL) that is licensed under separate terms, # as designated in a particular file or component or in included license # documentation. The authors of MySQL hereby grant you an additional # permission to link the program and your derivative works with the # separately licensed software that they have included with MySQL. # # 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, version 2.0, 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 mtr_report; 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}; if ($name =~ /^--/) { mtr_error("Options in a config file must not begin with --"); } my $opt; if ($value) { $opt = "--$name=$value"; } else { $opt = "--$name"; } 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 { 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 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; use strict; use warnings; use Carp; use IO::File; use File::Basename; # Constructor for My::Config, represents a my.cnf config file. sub new { my ($class, $path) = @_; my $group_name = undef; my $self = bless { groups => [] }, $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; $self->insert($group_name, undef, undef); } # Magic #! option (#!name=value) elsif ($line =~ /^(#\![\@\w-]+)\s*=\s*(.*?)\s*$/) { my $option = $1; my $value = $2; croak "Found option '$option=$value' outside of group" unless $group_name; $self->insert($group_name, $option, $value); } # Magic #! comments elsif ($line =~ /^#\!/) { my $magic = $line; croak "Found magic comment '$magic' outside of group" unless $group_name; $self->insert($group_name, $magic, undef); } # Comments elsif ($line =~ /^#/ || $line =~ /^;/) { # Skip comment next; } # 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)); } #