File Coverage

blib/lib/Env/Assert/Functions.pm

Criterion	Covered	Total	%
statement	88	92	95.6
branch	19	26	73.0
condition	10	15	66.6
subroutine	16	16	100.0
pod	3	3	100.0
total	136	152	89.4

## no critic (ControlStructures::ProhibitPostfixControls)
## no critic (ControlStructures::ProhibitCascadingIfElse)
## no critic (ValuesAndExpressions::ProhibitConstantPragma)
package Env::Assert::Functions;
use strict;
use warnings;
use 5.010;

# ABSTRACT: The functionality of Env::Assert and bin/envassert.

our $VERSION = '0.015';

use Exporter 'import';
our @EXPORT_OK = qw(
  assert
  report_errors
  file_to_desc
  ENV_ASSERT_MISSING_FROM_ENVIRONMENT
  ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
  ENV_ASSERT_MISSING_FROM_DEFINITION
);
our %EXPORT_TAGS = (
    'all' => [
        qw(
          assert
          report_errors
          file_to_desc
          ENV_ASSERT_MISSING_FROM_ENVIRONMENT
          ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
          ENV_ASSERT_MISSING_FROM_DEFINITION
        )
    ],
    'constants' => [
        qw(
          ENV_ASSERT_MISSING_FROM_ENVIRONMENT
          ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
          ENV_ASSERT_MISSING_FROM_DEFINITION
        )
    ],
);

use Cwd     qw( abs_path );
use English qw( -no_match_vars );
use File::Spec;
use IO::File;
use English qw( -no_match_vars );    # Avoids regex performance penalty in perl 5.18 and earlier
use Carp;

use constant {
    ENV_ASSERT_MISSING_FROM_ENVIRONMENT    => 1,
    ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE => 2,
    ENV_ASSERT_MISSING_FROM_DEFINITION     => 3,
};

use constant {
    DEFAULT_PARAMETER_BREAK_AT_FIRST_ERROR => 0,
    INDENT                                 => q{    },
};

sub assert {
    my ( $env, $want, $params ) = @_;
    $params = {} if !$params;
    croak 'Invalid options. Not a hash' if ( ref $env ne 'HASH' || ref $want ne 'HASH' );

    # Set default options
    $params->{'break_at_first_error'} //= DEFAULT_PARAMETER_BREAK_AT_FIRST_ERROR;

    my $success = 1;
    my %errors;
    my $vars = $want->{'variables'};
    my $opts = $want->{'options'};
    foreach my $var_name ( keys %{$vars} ) {
        my $var      = $vars->{$var_name};
        my $required = $var->{'required'} // 1;
        my $regexp   = $var->{'regexp'}   // q{.*};
        if ( ( $opts->{'exact'} || $required ) && !defined $env->{$var_name} ) {
            $success = 0;
            $errors{'variables'}->{$var_name} = {
                type    => ENV_ASSERT_MISSING_FROM_ENVIRONMENT,
                message => "Variable $var_name is missing from environment",
            };
            goto EXIT if ( $params->{'break_at_first_error'} );
        }
        elsif ( $env->{$var_name} !~ m/$regexp/msx ) {
            $success = 0;
            $errors{'variables'}->{$var_name} = {
                type    => ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE,
                message => "Variable $var_name has invalid content",
            };
            goto EXIT if ( $params->{'break_at_first_error'} );
        }
    }
    if ( $opts->{'exact'} ) {
        foreach my $var_name ( keys %{$env} ) {
            if ( !exists $vars->{$var_name} ) {
                $success = 0;
                $errors{'variables'}->{$var_name} = {
                    type    => ENV_ASSERT_MISSING_FROM_DEFINITION,
                    message => "Variable $var_name is missing from description",
                };
                goto EXIT if ( $params->{'break_at_first_error'} );
            }
        }
    }

  EXIT:
    return { success => $success, errors => \%errors, };
}

sub report_errors {
    my ($errors) = @_;
    my $out = q{};
    $out .= sprintf "Environment Assert: ERRORS:\n";
    foreach my $error_area_name ( sort keys %{$errors} ) {
        $out .= sprintf "%s%s:\n", INDENT, $error_area_name;
        foreach my $error_key ( sort keys %{ $errors->{$error_area_name} } ) {
            $out .= sprintf "%s%s: %s\n", INDENT . INDENT, $error_key, $errors->{$error_area_name}->{$error_key}->{'message'};
        }
    }
    return $out;
}

sub file_to_desc {
    my @rows = @_;
    my %desc = ( 'options' => {}, 'variables' => {}, );
    foreach (@rows) {

        # This is envassert meta command
        ## no critic (RegularExpressions::ProhibitComplexRegexes)
        if (
            m{
            ^ [[:space:]]{0,} [#]{2}
            [[:space:]]{1,} envassert [[:space:]]{1,}
            [(] opts: [[:space:]]{0,} (? .*) [)]
            [[:space:]]{0,} $
            }msx
          )
        {
            my $opts = _interpret_opts( $LAST_PAREN_MATCH{opts} );
            foreach ( keys %{$opts} ) {
                $desc{'options'}->{$_} = $opts->{$_};
            }
        }
        elsif (
            # This is comment row
            m{
                ^ [[:space:]]{0,} [#]{1} .* $
            }msx
          )
        {
            1;
        }
        elsif (
            # This is empty row
            m{
                ^ [[:space:]]{0,} $
            }msx
          )
        {
            1;
        }
        elsif (
            # This is env var description
            m{
                ^ (? [^=]{1,}) = (? .*) $
            }msx
          )
        {
            $desc{'variables'}->{ $LAST_PAREN_MATCH{name} } = { regexp => $LAST_PAREN_MATCH{value} };
        }
    }
    return \%desc;
}

# Private subroutines

sub _interpret_opts {
    my ($opts_str) = @_;
    my @opts = split qr{
        [[:space:]]{0,} [,] [[:space:]]{0,}
        }msx, $opts_str;
    my %opts;
    foreach (@opts) {
        my ( $key, $val ) = split qr/=/msx;
        $opts{$key} = $val;
    }
    return \%opts;
}

1;

__END__