view release on metacpan or  search on metacpan

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

    # make sure we can use ENV vars
    my $skip_env =  $ENV{ACT_OPT_skip_env};

    $realm ||=
      $self->{ARGV}->{realm} ||
	( $skip_env ? undef : $ENV{ACT_OPT_realm} ) ||
	  'default';

    # setup or get the merged YAML configuration settings from files
    # into the registry
    my $opts = $self->{REGISTRY}->get_realm( $realm );

    # first call
    if ( !keys %$opts ) {
	# define valid opts from config files
	try eval {
	    $self->_process_config_for( $realm );
	};

	# _set_reg throws err if $realm is invalid
	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_OPT_(.+)/;
		$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 project_home
					     realm conf_file 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( 'processing overrides: '.Dumper( $overrides ));

	# NOTE: bad (typo) keys could be in overrides. Someday,
	# Activator::Registry will allow debug mode so we can state
	# show this.
	if ( exists( $overrides->{ $realm } ) ) {
	    $self->{REGISTRY}->register_hash( 'right', $overrides->{ $realm }, $realm );
	}

	# now that realm is set, make sure our $opts points to it
	$opts = $self->{REGISTRY}->get_realm( $realm );

	# Override any provided command line options into this realm.
	# Strips known options out of \@ARGV
	$self->_argv_override( $opts, $argv );

	DEBUG( 'created opts: '.Dumper( $opts ));
    }
    else {
	DEBUG( 'found opts: '.Dumper( $opts ));
    }

    return $opts;
}

=head2 get_args()

Usage: Activator::Options->get_args( $argv_raw )

Takes a reference to a list of command line arguments (usually \@ARGV)
and returns a hash. C<$argv_raw> is not changed.

=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<$opts-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::Option> 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::Options->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_for {
    my ( $pkg, $realm ) = @_;
    my $self = &new( @_ );

    # figure out what project we are working on
    my $project =
      $self->{ARGV}->{project} ||
	$ENV{ACT_OPT_project} ||
	  Activator::Exception::Options->throw( 'project', 'missing' );

    # assemble a list of paths to look for config files
    # TODO: look in all these places:
    #   --conf_path
    #   ACT_OPT_conf_path
    #   $ENV{ACT_OPT_project_home}/.<$ENV{ACT_OPT_project}>.d/
    #   $ENV{HOME}/.<$ENV{ACT_OPT_project}>.d/
    #   $ENV{HOME}/.activator.d/
    #   /etc/<$ENV{ACT_OPT_project}>.d/
    #   /etc/activator.d/
    #

    # assemble a list of files to process into the keys of $seach_paths
    # TODO: assemble list of files for each of the above dirs
    #   --conf_file=       : use $self->{ARGV}->{conf_file} (which could be an arrayref )
    #   ACT_OPT_conf_file= : comma separated list of files