Activator
view release on metacpan or search on metacpan
lib/Activator/Config.pm view on Meta::CPAN
package Activator::Config;
use Data::Dumper;
use Activator::Registry;
use Activator::Log qw( :levels );
use Scalar::Util qw( reftype );
use Exception::Class::TryCatch;
use base 'Class::StrongSingleton';
=head1 NAME
C<Activator::Config> - provides a merged configuration to a script
combining command line options, environment variables, and
configuration files.
=head1 SYNOPSIS
use Activator::Config;
my $config = Activator::Config->get_config( \@ARGV); # default realm
my $config = Activator::Config->get_config( \@ARGV, $otherrealm);
#### Get a hashref of command line arguments, and an arrayref of bareword arguments
my ( $config, $args ) = Activator::Config->get_args( \@ARGV );
=head1 DESCRIPTION
This module allows a script or application to have a complex
configuration combining options from command line, environment
variables, and YAML configuration files.
For a script or application, one creates any number of YAML
configuration files. These files will be deterministically merged into
one hash. You can then pass this to an application or write it to file.
This module is not an options validator. It uses command line options
as overrides to existing keys in configuration files and DOES NOT
validate them. Unrecognized command line options are ignored and
C<@ARGV> is modified to remove recognized options, leaving barewords
and unrecognized options in place and the same order for a real
options validator (like L<Getopt::Long>). If you do use another
options module, make sure you call C<get_config()> BEFORE you call
their processor, so that C<@ARGV> will be in an appropriate state.
Environment variables can be used to act as a default to command line
options, and/or override any top level configuration file key which is
a scalar.
This module is cool because:
=over
=item *
You can generate merged, complex configuration heirarchies that are
context sensitive very easily.
=item *
You can pass as complex a config as you like to any script or
application, and override any scalar configuration option with your
environment variables or from the command line.
lib/Activator/Config.pm view on Meta::CPAN
ARGV_EXTRA => {},
ARGV => undef,
BAREWORDS => undef,
}, $pkg);
$self->_init_StrongSingleton();
return $self;
}
=head2 get_config()
Process command line arguments, environment variables and
configuration files then return a hashref representing the merged
configuration. Recognized configuration items are removed from C<@ARGV>.
Usage:
Activator::Config->get_config( \@ARGV, $realm, $project_is_arg );
C<$realm> is optional (default is 'default'). If undefined, it will be
determined from a command line option or environment variable.
C<$project_is_arg> is optional. Use any true value for this argument
if your script requries the project name as the last bareword
argument.
Examples:
#
# get options for default realm
#
my $config = Activator::Config->get_config( \@ARGV );
#
# get options for 'some' realm, ignoring --realm and ACT_CONFIG_realm
#
my $config = Activator::Config->get_config( \@ARGV, 'some' );
#
# don't ignore --realm and ACT_CONFIG_realm, use $barewords[-1] (the
# last bareword argument) as the project
#
Activator::Config->get_config( \@ARGV, undef, 1 );
See L</get_args()> for a description of the way command line arguments
are processed.
If called repeatedly, this sub does NOT reprocess C<\@ARGV>. This
allows you to make multiple calls to get a reference to the config for
multiple realms if desired.
=cut
sub get_config {
my ( $pkg, $argv, $realm, $project_is_arg ) = @_;
my $self = &new( @_ );
# get_args sets $self->{ARGV}
$self->get_args( $argv );
DEBUG( Data::Dumper->Dump( [ $self->{ARGV} ], [ qw/ ARGV / ] ) );
DEBUG( Data::Dumper->Dump( [ $self->{BAREWORDS} ], [ qw /BAREWORDS/ ] ) );
# make sure we can use ENV vars
my $skip_env = $ENV{ACT_CONFIG_skip_env};
$realm ||=
$self->{ARGV}->{realm} ||
( $skip_env ? undef : $ENV{ACT_CONFIG_realm} ) ||
'default';
if ( ref( $realm ) ) {
Activator::Exception::Config->throw( 'realm_specified_more_than_once', Dumper( $realm ) );
}
if ( $realm ne 'default' ) {
Activator::Registry->set_default_realm( $realm );
}
# setup or get the merged YAML configuration settings from files
# into the registry
my $config = $self->{REGISTRY}->get_realm( $realm );
# first call
if ( !keys %$config ) {
# define valid config from config files
try eval {
$self->_process_config_files( $realm, $skip_env, $project_is_arg );
};
if ( catch my $e ) {
$e->rethrow;
}
# read environment variables, set any keys found
if ( !$skip_env ) {
my ( $env_key, $env_realm );
foreach my $env_key ( keys %ENV ) {
next unless $env_key =~ /^ACT_CONFIG_(.+)/;
$opt_key = $1;
$opt_realm = $realm;
my $env_opt_realm = $opt_realm;
my $env_opt_key = $opt_key;
if ( $opt_key =~ /^_(\w+)__(\w+)$/ ) {
$env_opt_realm = $1;
$env_opt_key = $2;
if ( $env_opt_realm eq $realm ) {
$opt_key = $env_opt_key;
$opt_realm = $env_opt_realm;
}
}
if ( $self->{REGISTRY}->get( $opt_key, $opt_realm ) ) {
$self->{REGISTRY}->register( $opt_key, $ENV{ $env_key }, $opt_realm );
}
elsif( $env_opt_realm ne $opt_realm &&
!grep( /$opt_key/, qw( skip_env project
realm conf_path ) ) ) {
WARN( "Skipped invalid environment variable $env_key. Key '$opt_key' for realm '$opt_realm' unchanged");
}
}
}
# forced overrides from config files
my $overrides = $self->{REGISTRY}->get_realm( 'overrides' );
DEBUG( Data::Dumper->Dump( [ $overrides ], [ 'processing overrides' ] ) );
# NOTE: bad (typo) keys could be in overrides. Someday,
# Activator::Registry will allow debug mode so we can
# show this.
if ( exists( $overrides->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'right', $overrides->{ $realm }, $realm );
}
# now that realm is set, make sure our $config points to it
$config = $self->{REGISTRY}->get_realm( $realm );
# Override any provided command line options into this realm.
# Strips known options out of \@ARGV
$self->_argv_override( $config, $argv );
# inject some env variables that we support
# TODO: make this cross-platform
$config->{HOME} = $ENV{HOME};
$config->{USER} = $ENV{USER};
# feed the realm to itself for any self-defined variables
$self->{REGISTRY}->replace_in_realm( $realm, $config );
DEBUG( 'generated ' . Data::Dumper->Dump( [ $config ], [ qw/ config / ] ) );
}
else {
DEBUG( 'found ' . Data::Dumper->Dump( [ $config ], [ qw/ config / ] ) );
}
return $config;
}
=head2 get_args()
Takes a reference to a list of command line arguments (usually
C<\@ARGV>) and returns an arrayref consisting of an options hash, and
a barewords arrayref. C<$argv_raw> is not changed.
Usage: Activator::Config->get_args( $argv_raw )
=over
=item *
Arguments can be barewords, '-' notation or '--' notation.
=item *
Any arguments after the arguments terminator symbol (a plain '--'
argument) are returned as barewords. Bareword order of specification
is maintained.
=item *
Values with spaces must be double-quoted, and can themselves contain quotes
--mode="sliding out of control"
--plan="pump the "brakes" vigorously"
=item *
Flag arguments are counted. That is C<-v -v> would set C<$config-E<gt>{v} = 2>
=item *
Argument bundling is not supported.
=back
Examples:
@ARGV | Value returned
----------------------+-----------------------------------------
--arg | $argv = { arg => 1 }
--arg --arg | $argv = { arg => 2 }
--arg=val | $argv = { arg => 'val' }
--arg=val --arg=val2 | $argv = { arg => [ 'val', 'val2' ] }
--arg="val val" | $argv = { arg => 'val val' }
Returns array: C<( $args_hashref, $barewords_arrayref )>
Throws C<Activator::Exception::Config> when arg is invalid (which at this
time is only when a barewod arg of '=' is detected).
=cut
sub get_args {
lib/Activator/Config.pm view on Meta::CPAN
return $arg;
}
my ( $key, $value ) = split /=/xms, $arg, 2;
if ( !defined $key ) {
Activator::Exception::Config->throw( 'argument',
'invalid',
$arg );
}
# clean up key
$key =~ s/^--?//;
# clean up value, if quoted
if ( defined $value ) {
$value =~ s/^"//;
$value =~ s/"$//;
}
return ( $key, $value );
}
# Merge config files into this objects Activator::Registry object
sub _process_config_files {
my ( $pkg, $realm, $skip_env, $project_is_arg ) = @_;
my $self = &new( @_ );
# figure out what project we are working on
my $project =
$self->{ARGV}->{project} ||
( $project_is_arg ? $self->{BAREWORDS}->[-1] : undef ) ||
( $skip_env ? undef : $ENV{ACT_CONFIG_project} ) ||
Activator::Exception::Config->throw( 'project', 'missing' );
# process these files:
# $ENV{USER}.yml
# <realm>.yml - realm specific settings and defaults
# <project>.yml - project specific settings and defaults
# org.yml - top level organization settings and defaults
# in one of these paths, if set
# --conf_file= : use $self->{ARGV}->{conf_file} (which could be an arrayref )
# ACT_CONFIG_conf_file= : comma separated list of files
my $conf_path = $self->{ARGV}->{conf_path};
if ( ! $conf_path ) {
$conf_path = ( $skip_env ? undef : $ENV{ACT_CONFIG_conf_path} );
if ( !$conf_path ) {
ERROR( "Neither ACT_CONFIG conf_path env var nor --conf_path set");
Activator::Exception::Config->throw( 'conf_path', 'missing' );
}
else {
INFO( "Using ACT_CONFIG_conf_path env var: $conf_path");
}
}
else {
INFO( "Using conf_path argument: $conf_path");
}
my @search_paths = split ':', $conf_path;
DEBUG( 'Searching for conf files in: ' . Data::Dumper->Dump( [ \@search_paths ], [ qw/ search_paths / ] ) );
# Search for these files, create a files lookup.
my $files = { user => { target => "$ENV{USER}.yml" },
realm => { target => "${realm}.yml" },
project => { target => "${project}.yml" },
org => { target => 'org.yml' } };
foreach my $path ( @search_paths ) {
$path =~ s|/$||;
foreach my $which ( keys %$files ) {
my $target = $files->{ $which }->{target};
if ( !opendir DIR, $path ) {
WARN( "Ignoring invalid path '$path'" );
} else {
my @found = grep { /^$target$/ && -f "$path/$_" } readdir(DIR);
if ( @found ) {
my $file = "$path/$found[0]";
if ( !exists( $files->{ $which }->{ file } ) ) {
$files->{ $which }->{file} = $file;
} else {
INFO( "Ignoring lower priority config file '$file'" );
}
}
}
}
}
DEBUG ( 'Processing config files: ' . Data::Dumper->Dump( [ $files ], [ qw/ files / ] ) );
# now that we have all the files, import 'em! This is a super long
# winded but safe "left precedence" merge of all files
my ( $user_config, $realm_config, $project_config, $org_config );
try eval {
if ( exists( $files->{user}->{file} ) ) {
$user_yml = YAML::Syck::LoadFile( $files->{user}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'user_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{realm}->{file} ) ) {
$realm_yml = YAML::Syck::LoadFile( $files->{realm}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'realm_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{project}->{file} ) ) {
$project_yml = YAML::Syck::LoadFile( $files->{project}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'project_config', 'invalid', $e );
}
try eval {
if ( exists( $files->{org}->{file} ) ) {
$org_yml = YAML::Syck::LoadFile( $files->{org}->{file} );
}
};
if ( catch my $e ) {
Activator::Exception::Config->throw( 'org_config', 'invalid', $e );
}
if ( $realm ne 'default' ) {
if ( defined( $user_yml ) && exists( $user_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $user_yml->{ $realm }, $realm );
DEBUG('Registered: ' . $files->{user}->{file} . " for realm $realm" );
}
if ( defined( $realm_yml ) && exists( $realm_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml->{ $realm }, $realm );
DEBUG('Registered: ' . $files->{realm}->{file} . " for realm $realm" );
}
if ( defined( $project_yml ) && exists( $project_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $project_yml->{ $realm }, $realm );
DEBUG('Registered: ' . $files->{project}->{file} . " for realm $realm" );
}
if ( defined( $org_yml ) && exists( $org_yml->{ $realm } ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml->{ $realm }, $realm );
DEBUG('Registered: ' . $files->{org}->{file} . " for realm $realm" );
lib/Activator/Config.pm view on Meta::CPAN
}
elsif ( exists( $user_yml->{act_config_no_realms} ) ) {
$self->{REGISTRY}->register_hash( 'left', $user_yml, $realm );
}
DEBUG('Registered: ' . $files->{user}->{file} . " for default realm" );
}
if ( defined( $realm_yml ) ) {
if ( exists( $realm_yml->{default} ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml->{default}, $realm );
}
elsif ( exists( $realm_yml->{act_config_no_realms} ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml, $realm );
}
DEBUG('Registered: ' . $files->{realm}->{file} . " for default realm" );
}
if ( defined( $project_yml ) ) {
if ( exists( $project_yml->{default} ) ) {
$self->{REGISTRY}->register_hash( 'left', $project_yml->{default}, $realm );
}
elsif ( exists( $project_yml->{act_config_no_realms} ) ) {
$self->{REGISTRY}->register_hash( 'left', $project_yml, $realm );
}
DEBUG('Registered: ' . $files->{project}->{file} . " for default realm" );
}
if ( defined( $org_yml ) ) {
if ( exists( $org_yml->{default} ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml->{default}, $realm );
}
elsif ( exists( $org_yml->{act_config_no_realms} ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml, $realm );
}
DEBUG('Registered: ' . $files->{org}->{file} . " for default realm" );
}
if ( defined( $user_yml ) && exists( $user_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $user_yml->{overrides}, 'overrides' );
DEBUG('Registered: ' . $files->{user}->{file} . " overrides" );
}
if ( defined( $realm_yml ) && exists( $realm_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $realm_yml->{overrides}, 'overrides' );
DEBUG('Registered: ' . $files->{realm}->{file} . " overrides" );
}
if ( defined( $project_yml ) && exists( $project_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $project_yml->{overrides}, 'overrides' );
DEBUG('Registered: ' . $files->{project}->{file} . " overrides" );
}
if ( defined( $org_yml ) && exists( $org_yml->{overrides} ) ) {
$self->{REGISTRY}->register_hash( 'left', $org_yml->{overrides}, 'overrides' );
DEBUG('Registered: ' . $files->{org}->{file} . " overrides" );
}
# make sure all is kosher
my $test = $self->{REGISTRY}->get_realm( $realm );
if ( !keys %$test ) {
DEBUG( Data::Dumper->Dump( [ $self->{REGISTRY} ], [ qw/ registry / ] ) );
ERROR( "After processing, '$realm' realm should not be empty, but it is!");
Activator::Exception::Config->throw('realm', 'empty', $realm);
}
}
# Override any options in $config with the values in $argv. Sets non-existent keys.
#
# Arguments:
# $config : hashref to the options for $realm
# $argv : arrayref to command line arguments. All recognized options are removed.
#
sub _argv_override {
my ( $self, $config, $argv ) = @_;
my @barewords;
my @unrec;
# loop through $argv (which we assume to be a ref to @ARGV) and
# set any config keys if they exist.
while ( my $arg = shift @$argv ) {
my ( $key, $value ) = $self->_get_arg( $arg );
# ignore barewords
if ( ! defined( $key ) ) {
DEBUG("Ignoring bareword '$arg'");
push @unrec, $arg;
next;
}
# finish up if we find terminator
if ( $key eq '--' ) {
DEBUG("Found arguments terminator --");
unshift @$argv, '--';
last;
}
# TODO: consider supporting realm specific command line arguments
#
# # skip this key if it is for a different realm
# if ( $key =~ /^__(\w+)__(\w+)$/ ) {
# $key_realm = $1;
# $key = $2;
# if( $realm ne $key_realm ) {
# push @unrec, $arg;
# next;
# }
# }
# leave this key in @ARGV if we don't recognize it
if( !exists( $config->{ $key } ) ) {
push @unrec, $arg;
}
# set the value no matter what
$config->{ $key } = $value;
}
unshift @$argv, @unrec;
}
( run in 0.597 second using v1.01-cache-2.11-cpan-39bf76dae61 )