I really like YAML. But I often find myself adding perl-like variables and fallbacks to defaults. Does anyone else do that? Do people still use YAML or has everybody moved on to JSON?
Anyway, there may already be a module to do this, but the more the merrier right 😉
I have to work with a lot of databases, and there is often, but not always a pattern between the database, the username and the password
Please note I’m not advocating putting plaintext passwords in a config file – that is generally a bad idea. This is just for the purposes of the example.
---
default:
_base: [~VAR, ~ENV]
aliases:
db:
_base: []
default:
x: y
other:
_base: [db/default]
database:
_base: [~VAR, database/default, ~ENV]
default:
_base: []
server: DB_$[UC_ALIAS]_SERVER
database: $[ALIAS]
user: $[ALIAS]_user
password: $[USER]_1
# --
saturn: 1
neptune: 1
mars:
_base: [~VAR, database/default, db/other]
password: qwerty
So basically, this config file says that there are three databases – saturn, neptune and mars. Username is (for example) saturn_user and the password would be saturn_user_1 except for mars which has a special password of qwerty.
I’ll stick to a fairly standard Object Based approach.
package MyConfig;
use strict;
use warnings;
use YAML;
sub new
{
my ($class, $file) = @_;
# error checking elided
my $self = { yaml => YAML::LoadFile($file) };
bless $self, $class;
return $self;
}
~VAR mentioned in the YAML above can be set by a member method.
sub set_var
{
my ($self, $var, $value) = @_;
$self->{'vars'}{$var} = $value;
}
Now, you can probably see my intent from the yaml above, that I’m using forward-slash as my namespace seperator and variables from more global namespaces are overridden by more local namespaces. Anyway, I need some way of iterating over these namespaces – I like closures for this sort of thing.
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);
}
}
Getting the base is an important task as it determines the fallbacks. This uses the iterator mentioned above.
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;
}
I’m using a helper function here as even perl is not quite loose enough for me by default. Attempting index an undefined value as a hash reference is fatal. Anyway, that is fixable.
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;
}
Getting the alias data also uses the iterator closure.
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;
}
We will want to set which alias we are using before retrieving params. This will set a couple of convenience variables, ALIAS and UC_ALIAS. We’ll provide a flag parameter to avoid clearing any preset variables.
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);
}
And after all that, we are able to retrieve the param, correctly with fallbacks.
Note: this is somewhat prone to infinite recursion if you are not careful with setting your _base parameters in the yaml. I had intended to detect this with $self->{'params'} but this overly bloats the code for the purposes of the post.
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));
}
}
}
return $retval;
}
A little test program to check it is working correctly at this stage.
my $file = shift;
my $cfg = MyConfig->new($file);
foreach my $alias (qw(database/saturn database/mars databasky/neptune)) {
print "Alias: $alias\n";
$cfg->set_alias($alias);
foreach (qw(server database user password x)) {
my $param = $cfg->param($_);
$param = '' unless defined($param);
print "$_: $param\n";
}
print "\n";
}
And the result. Looks okay to me.
$ perl MyConfig.pl db-test.yaml
Alias: database/saturn
server: DB_$[UC_ALIAS]_SERVER
database: $[ALIAS]
user: $[ALIAS]_user
password: $[USER]_1
x:
Alias: database/mars
server: DB_$[UC_ALIAS]_SERVER
database: $[ALIAS]
user: $[ALIAS]_user
password: qwerty
x: y
Alias: databasky/neptune
AliasError: unable to find alias databasky
Next time, we’ll talk about substituting those variables. I was going to mention it here, but this post is long enough already.
Read Full Post »
A Curious Programmer 
