Last time, I left you with a bit of a cliffhanger. I’d implemented fallbacks but I still wasn’t substituting variables which I promised for this time. It turns out that the solution is really simple.
my %matching_bracket = qw#{ } ( ) [ ]#; sub param { my ($self, $param, $full_alias, $base_ref) = @_; $full_alias = $self->{'full_alias'} if (! defined($full_alias)); $base_ref = $self->{'base'} if (! defined($base_ref)); my $alias_data = $self->get_alias_data($full_alias); my $retval = get_if_hash($alias_data, $param); if (! defined($retval)) { foreach my $fallback (@$base_ref) { if ($fallback eq '~VAR') { if (exists($self->{'vars'}{$param})) { $retval = $self->{'vars'}{$param}; last; } } elsif ($fallback eq '~ENV') { if (exists($ENV{$param})) { $retval = $ENV{$param}; last; } } else { $retval = $self->param($param, $fallback, $self->get_base($fallback)); last if (defined($retval)); } } } if (defined($retval)) { # Substitute any variables which are present $retval =~ s/\$([{([]) ([^}\])]+) # $matching_bracket{\1} [})\]] /$self->param(lc($2))/egx; } return $retval; }
I was disappointed that I couldn’t quickly get %matching_bracket
to work, but for my purposes it doesn’t matter that much.
param()
is fairly complex now. It recursively calls itself a few times to get the appropriate fallback and it is important to pass the correct $full_alias
and $base_ref
to ensure we are making progress towards the base case.
The result is pleasing.
$ perl MyConfig.pl db-test.yaml Alias: database/saturn server: DB_SATURN_SERVER database: saturn user: saturn_user password: saturn_user_1 x: Alias: database/mars server: DB_MARS_SERVER database: mars user: mars_user password: qwerty x: y Alias: databasky/neptune AliasError: unable to find alias databasky
A couple of things I’m not completely happy with:
- it should detect infinite recursion
%matching_bracket
doesn’t work- the class name – would
YAML::Extended
be reasonable?
The Full Source
package MyConfig; use strict; use warnings; use YAML; sub get_if_hash { my ($hash_ref, $key) = @_; if (defined($hash_ref) and ref($hash_ref) eq 'HASH' and exists $hash_ref->{$key}) { return $hash_ref->{$key}; } # Clarify that we are returning undef deliberately return undef; } sub new { my ($class, $file) = @_; my $self = { yaml => YAML::LoadFile($file) }; bless $self, $class; return $self; } sub alias_parts_iterator { my ($self, $full_alias, $fn) = @_; my $partial = ''; my $alias_data = $self->{'yaml'}{'aliases'}; my @parts = split '/', $full_alias; foreach (@parts) { $partial .= '/' if length($partial); $partial .= (length($partial) ? '/' : '') . $_; if (! exists $alias_data->{$_}) { die "AliasError: unable to find alias $partial\n"; } $alias_data = $alias_data->{$_}; $fn->($self, $alias_data, $partial); } } sub get_base { my ($self, $full_alias) = @_; my $base; $self->alias_parts_iterator( $full_alias, sub { my ($obj, $alias_data) = @_; my $_base = get_if_hash($alias_data, '_base'); $base = $_base if (defined($_base)); } ); if (! defined($base)) { if (exists($self->{'yaml'}{'default'}{'_base'})) { $base = $self->{'yaml'}{'default'}{'_base'}; } else { $base = []; } } return $base; } sub get_alias_data { my ($self, $full_alias) = @_; my $alias_data; $self->alias_parts_iterator( $full_alias, sub { my ($obj, $_alias_data) = @_; $alias_data = $_alias_data; } ); return $alias_data; } sub set_var { my ($self, $var, $value) = @_; $self->{'vars'}{$var} = $value; } sub set_alias { my ($self, $full_alias, $flags) = @_; $self->{'params'} = {}; my $clear_flag = get_if_hash($flags, 'clear'); $self->{'vars'} = {} unless defined($clear_flag) and $clear_flag eq 0; $self->{'full_alias'} = $full_alias; if ($full_alias =~ m{([^/]+$)}) { $self->set_var('alias', lc($1)); $self->set_var('uc_alias', uc($1)); } $self->{'base'} = $self->get_base($full_alias); } my %matching_bracket = qw#{ } ( ) [ ]#; sub param { my ($self, $param, $full_alias, $base_ref) = @_; $full_alias = $self->{'full_alias'} if (! defined($full_alias)); $base_ref = $self->{'base'} if (! defined($base_ref)); my $alias_data = $self->get_alias_data($full_alias); my $retval = get_if_hash($alias_data, $param); if (! defined($retval)) { foreach my $fallback (@$base_ref) { if ($fallback eq '~VAR') { if (exists($self->{'vars'}{$param})) { $retval = $self->{'vars'}{$param}; last; } } elsif ($fallback eq '~ENV') { if (exists($ENV{$param})) { $retval = $ENV{$param}; last; } } else { $retval = $self->param($param, $fallback, $self->get_base($fallback)); last if (defined($retval)); } } } if (defined($retval)) { # Substitute any variables which are present $retval =~ s/\$([{([]) ([^}\])]+) # $matching_bracket{\1} [})\]] /$self->param(lc($2))/egx; } return $retval; }
Leave a Reply