File Coverage

blib/lib/ENV/Util.pm

Criterion	Covered	Total	%
statement	61	66	92.4
branch	23	34	67.6
condition	8	15	53.3
subroutine	8	8	100.0
pod	3	3	100.0
total	103	126	81.7

package ENV::Util;
use strict;
use warnings;

our $VERSION = 0.03;

sub import {
    my ($pkg, $cmd, @args) = @_;
    return if !defined $cmd;
    if ($cmd eq '-load_dotenv') {
        load_dotenv(@args)
    }
    else {
        local($!, $^E);
        my ($pkg, $file, $line) = caller(1);
        die "invalid import action for $pkg in $file line $line.";
    }
}

sub prefix2hash {
    my ($prefix) = @_;
    $prefix = '' unless defined $prefix;
    my $start_index = length($prefix);
    my %options = map { lc(substr($_, $start_index)) => $ENV{$_} } grep index($_, $prefix) == 0, keys %ENV;
    return %options;
}

sub load_dotenv {
    my ($filename) = @_;
    $filename = '.env' unless defined $filename;
    return unless -f $filename;

    open my $fh, '<:raw:encoding(UTF-8)', $filename
      or die "unable to open env file '$filename': $!";

    my @lines;
    { local $!; @lines = <$fh> }
    my %env;
    # POSIX convention for env variable names:
    my $varname_re = qr/[a-zA-Z_][a-zA-Z0-9_]+/;
    foreach my $line (@lines) {
        # code heavily inspired by Dotenv.pm (BooK++)
        if (my ($k, $v) = $line =~ m{
            \A\s*
            # 'export' (bash), 'set'/'setenv' ([t]csh) are optional keywords:
            (?: (?:export|set|setenv) \s+ )?
            ( $varname_re )
            (?: \s* (?:=|\s+) \s* )       # separator is '=' or spaces
            (
              '[^']*(?:\\'|[^']*)*'  # single quoted value
             |"[^"]*(?:\\"|[^"]*)*"  # or double quoted value
             | [^\#\r\n]+            # or unquoted value
            )?
            \s* (?: \# .* )?            # inline comment
            \z}sx
        ) {
            $v = '' unless defined $v;
            $v =~ s/\s*\z//;

            my $interpolate_vars = 1; # unquoted strings interpolate variables.

            # drops quotes from quoted values, and interpolate if double quoted:
            if ( $v =~ s/\A(['"])(.*)\1\z/$2/) {
                if ($1 eq '"' ) {
                    $v =~ s/\\n/\n/g;
                    $v =~ s/\\//g;
                }
                else {
                    $interpolate_vars = 0;
                }
            }

            if ($interpolate_vars) {
                # $env{$1} could point to a variable that doesn't exist.
                no warnings 'uninitialized';
                $v =~ s{\$($varname_re)}{exists $ENV{$1} ? $ENV{$1} : $env{$1}}ge;
            }
            $env{$k} = $v;
        }
    }
    %ENV = (%env, %ENV);
    return;
}

sub redacted_env {
    my (%opts) = @_;
    if (!$opts{rules}) {
        $opts{rules} = [
            {
                key => qr(USER|ID|NAME|MAIL|ACC|TOKEN|PASS|PW|SECRET|KEY|ACCESS|PIN|SSN|CARD|IP),
                mask => '',
            },
            {
                value => qr(\@|:|=),
                mask  => '',
            },
        ]
    }
    my %redacted;
    ENVKEY:
    foreach my $k (keys %ENV) {
        my $v = $ENV{$k};
        foreach my $rule (@{ $opts{rules} }) {
            if ( ($rule->{key} && $k =~ $rule->{key})
              || ($rule->{value} && $v =~ $rule->{value})
            ) {
              if ( ($rule->{key} && $k =~ $rule->{key}) ) {
              } elsif($rule->{value} && $v =~ $rule->{value}) {
              }
              next ENVKEY if $rule->{drop};
              $v = $rule->{mask};
              last;
            }
        }
        $redacted{$k} = $v;
    }
    return %redacted;
}

1;
__END__