Extending YAML Configuration Files

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.

---

1. Well, not really, but for the purposes of the example…