File Coverage

blib/lib/AWS/CLI/Config.pm

Criterion	Covered	Total	%
statement	86	93	92.4
branch	25	36	69.4
condition	22	54	40.7
subroutine	20	22	90.9
pod	2	2	100.0
total	155	207	74.8

package AWS::CLI::Config;

use 5.008001;
use strict;
use warnings;

use Carp ();
use File::Spec;
use autodie;

our $VERSION = '0.05';

my $DEFAULT_PROFILE = 'default';

my $CREDENTIALS;
my %CREDENTIALS_PROFILE_OF;
my $CONFIG;
my %CONFIG_PROFILE_OF;

BEGIN: {
    my %attributes = (
        access_key_id => {
            env => 'AWS_ACCESS_KEY_ID',
            key => 'aws_access_key_id'
        },
        secret_access_key => {
            env => 'AWS_SECRET_ACCESS_KEY',
            key => 'aws_secret_access_key',
        },
        session_token => {
            env => 'AWS_SESSION_TOKEN',
            key => 'aws_session_token',
        },
        region => { env => 'AWS_DEFAULT_REGION' },
        output => {},
    );

    while (my ($name, $opts) = each %attributes) {
        no strict 'refs';
        *{__PACKAGE__ . "::$name"} = _mk_accessor($name, %{$opts});
    }
}

sub _mk_accessor {
    my $attr = shift;
    my %opt  = @_;

    my $env_var = $opt{env};
    my $profile_key = $opt{key} || $attr;

    return sub {
        if ($env_var && exists $ENV{$env_var} && $ENV{$env_var}) {
            return $ENV{$env_var};
        }

        my $profile = shift || _default_profile();

        my $credentials = credentials($profile);
        if ($credentials && $credentials->$profile_key) {
            return $credentials->$profile_key;
        }

        my $config = config($profile);
        if ($config && $config->$profile_key) {
            return $config->$profile_key;
        }

        return undef;
    };
}

sub credentials {
    my $profile = shift || _default_profile();

    $CREDENTIALS ||= _parse(
        (exists $ENV{AWS_CONFIG_FILE} and $ENV{AWS_CONFIG_FILE})
            ? $ENV{AWS_CONFIG_FILE}
            : File::Spec->catfile(_default_dir(), 'credentials')
    );

    return unless (exists $CREDENTIALS->{$profile});
    $CREDENTIALS_PROFILE_OF{$profile} ||=
        AWS::CLI::Config::Profile->new($CREDENTIALS->{$profile});
    return $CREDENTIALS_PROFILE_OF{$profile};
}

sub config {
    my $profile = shift || _default_profile();

    $CONFIG ||= _parse(
        (exists $ENV{AWS_CONFIG_FILE} and $ENV{AWS_CONFIG_FILE})
            ? $ENV{AWS_CONFIG_FILE}
            : File::Spec->catfile(_default_dir(), 'config')
    );

    return unless (exists $CONFIG->{$profile});
    $CONFIG_PROFILE_OF{$profile} ||=
        AWS::CLI::Config::Profile->new($CONFIG->{$profile});
    return $CONFIG_PROFILE_OF{$profile};
}

sub _base_dir {
    ($^O eq 'MSWin32') ? $ENV{USERPROFILE} : $ENV{HOME};
}

sub _default_dir {
    File::Spec->catdir(_base_dir(), '.aws');
}

sub _default_profile {
    (exists $ENV{AWS_DEFAULT_PROFILE} && $ENV{AWS_DEFAULT_PROFILE})
        ? $ENV{AWS_DEFAULT_PROFILE}
        : $DEFAULT_PROFILE;
}

# This only supports one level of nesting, but it seems AWS config files
# themselves only have but one level
sub _parse {
    my $file = shift;
    my $profile = shift || _default_profile();

    my $hash = {};
    my $nested = {};

    return +{} unless -r $file;

    my $contents;
    {
        local $/  = undef;
        open my $fh, '<', $file;
        $contents = <$fh>;
        close( $fh );
    }

    foreach my $line (split /\n/, $contents) {
        chomp $line;

        $profile = $1 if $line =~ /^\[(?:profile )?([\w]+)\]/;
        my ($indent, $key, $value) = $line =~ /^(\s*)([\w]+)\s*=\s*(.*)/;

        next if !defined $key or $key eq q{};

        if (length $indent) {
            $nested->{$key} = $value;
        }
        else {
            # Reset nested hash
            $nested = {} if keys %{$nested};
            $hash->{$profile}{$key} = ($key and $value) ? $value : $nested;
        }
    }

    return $hash;
}

PROFILE: {
    package AWS::CLI::Config::Profile;

    use 5.008001;
    use strict;
    use warnings;

    sub new {
        my $class = shift;
        my $data = @_ ? @_ > 1 ? { @_ } : shift : {};
        return bless $data, $class;
    }

    sub AUTOLOAD {
        our $AUTOLOAD;
        my $self = shift;

        return if $AUTOLOAD =~ /DESTROY/;
        my $method = $AUTOLOAD;
           $method =~ s/.*:://;

        no strict 'refs';
        *{$AUTOLOAD} = sub {
          return shift->{$method}
        };

        return $self->{$method};
    }
}

1;

__END__