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 password1
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…
I really should learn YAML.
“Please note Iβm not advocating putting plaintext passwords in a config file β that is generally a bad idea.”
Has anybody, anywhere, ever figured out a good place to put database passwords?
Hi Sue,
Yes, I think it is worth learning YAML, or JSON or some other configuration language. XML is too painful and evalling perl data structures is a bit suspect π
Yes – keep it in your head π
But more seriously, it would be better to use some kind of authentication mechanism such as SASL and then grant tickets (like perforce does) or maybe even a full-blooded authenticating / ticketing system such as Kerberos.
Hi Folks
Whether you like YAML or not, it’s effectively dead and gone. Accept this reality and forget it.
As for the YAML at the start of the article, it’s really looks like the intention is to write code in YAML. Bad idea. See also XSL.
One of the myriad of problems is the other code is required to compensate for all the things YAML can’t do. So why put a little bit of code in YAML in the first place?
And so on…
Hi Ron,
Where did you get the idea that YAML is dead? Do you have links or other evidence? I did a google search on YAML is dead. None of the links on the first page talked about YAML begin dead.
And I think that perhaps you and I have a different definition of code (aside from the fact I’m a sometime Lisper – code *is* data). Trivial variable interpolation does not, code make. And what is your alternative?
Never mind the detractors. I still use YAML *a lot*. It’s just too nice to type and too pretty to be dumped. JSON is limited and a bit bothersome to type. It simply cannot and will never completely replace YAML.
I don’t put code in YAML, but I encounter this “foo based on bar” problem often. My Config::Tree::YAMLHashDir module is one way I do it, by putting several hashes on a single YAML or separate YAML files, and then merging them together to get the final result.
Hi Steven,
I agree. YAML is the nicest looking thing for config files I’ve seen. In that context, neither XML nor JSON would be acceptable alternatives to me (and no-one has suggested anything else).
I’ll have to take a look at your Config::Tree::YAML* modules. Thanks for pointing them out.