view release on metacpan or  search on metacpan

lib/Activator/Config.pm  view on Meta::CPAN

	( $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 {
    my ( $pkg, $argv_raw ) = @_;
    my $self = &new( @_ );

    # quick and dirty check for debug mode
    if( grep /^--?debug$/, @$argv_raw ) {
	Activator::Log->level('DEBUG');
	DEBUG('Entering debug mode');
    }

    if ( defined( $self->{ARGV} ) || defined( $self->{BAREWORDS} ) ) {
	DEBUG("skipping ARGV reprocessing");
	return ( $self->{ARGV}, $self->{BAREWORDS} );
    }

    DEBUG("got ARGV: ". join(' ', @$argv_raw ));

    # use refs to insure that that $self->{ARGV} and
    # $self->{BAREWORDS} are defined, so we don't return undef.
    my $argv = {};
    my $barewords = [];
    my $found_terminator = 0;

    foreach my $arg ( @$argv_raw ) {
	my ( $key, $value ) = $self->_get_arg( $arg );

	if ( $found_terminator || !defined( $key ) ) {
	    DEBUG("'$arg' is a bareword or after the args terminator '--'");
	    push @$barewords, $arg;
            next;
	}

	if( $key eq '--' ) {
	    DEBUG("'$arg' is the terminator");
	    $found_terminator = 1;
	    next;
	}

        if ( defined $value ) {
	    DEBUG("got key '$key' = '$value'");

	    # if we see an argument again, coerce this value into an
	    # array
            if ( exists $argv->{ $key } ) {
		if ( reftype ( $argv->{ $key } ) eq 'ARRAY' ) {
		    DEBUG("added '$value' to key list '$key'" );
		    push @{ $argv->{ $key } }, $value;
		}
		else {
		    DEBUG("created key list '$key' and added '$value'" );
		  $argv->{ $key } = [ $argv->{ $key }, $value ];
	      }
	    }
	    # just set it
	    else {
		$argv->{ $key } = $value;
	    }
	}
        else {

	    # if we see a value again, increment the occurence count
	    if ( exists $argv->{ $key } ) {
		DEBUG("incremented key '$key'" );
		$argv->{ $key }++;
	    }
	    else {
		DEBUG("set $key" );
		$argv->{ $key } = 1;
	    }
        }
    }

    # save these so we don't have to do it again
    $self->{ARGV}      = $argv;
    $self->{BAREWORDS} = $barewords;

    return ( $argv, $barewords );
}

# Helper to split an arg into key/value. Returns ($key, $value), where
# $value is undef if the argument is flag format (--debug), undef if
# it is a bareword ( foo ) and '--' if it is the arguments terminator
# symbol.
#
sub _get_arg {
    my ( $self, $arg ) = @_;

    if ( $arg !~ /^-(-)?/ ) {
	return;
    }

    if ( $arg eq '--' ) {
	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");