view release on metacpan or  search on metacpan

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

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 / ] ) );
    }

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

        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");
	    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" );
	}
    }

    if ( defined( $user_yml ) ) {
	if ( exists( $user_yml->{default} ) ) {
	    $self->{REGISTRY}->register_hash( 'left', $user_yml->{default}, $realm );
	}
	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;

}

# do variable replacements throughout
sub _var_replace {