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 )