File Coverage

blib/lib/Env/Assert.pm

Criterion	Covered	Total	%
statement	52	56	92.8
branch	12	22	54.5
condition	7	9	77.7
subroutine	11	11	100.0
pod	1	1	100.0
total	83	99	83.8

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

# ABSTRACT: Ensure that the environment variables match what you need, or abort.

our $VERSION = '0.015';

# We define our own import routine because
# this is the point (when `use Env::Assert` is called)
# when we do our magic.

use Carp;

use English qw( -no_match_vars );    # Avoids regex performance penalty in perl 5.18 and earlier
use open ':std', IO => ':encoding(UTF-8)';

use Env::Assert::Functions qw( :all );

use constant { ENV_DESC_FILENAME => '.envdesc', };

# Handle exports
{
    no warnings 'redefine';    ## no critic [TestingAndDebugging::ProhibitNoWarnings]

    sub import {
        my ( $class, $cmd, $args ) = @_;

        # We also allow only: 'use Env::Assert;'
        croak "Unknown argument '$cmd'" if ( $cmd && $cmd ne 'assert' );

        if ( !assert_env( %{$args} ) ) {
            croak 'Errors in environment detected.';
        }
        return;
    }
}

sub assert_env {
    my (%args) = @_;
    local $OUTPUT_AUTOFLUSH = 1;

    my $break_at_first_error = $args{'break_at_first_error'} // 0;
    my $exact                = $args{'exact'}                // 0;

    my @env_desc_rows;
    if ( $args{'envdesc'} ) {
        my $content = $args{'envdesc'};
        open my $fh, q{<}, \$content
          or croak 'Cannot open scalar envdesc content';
        @env_desc_rows = <$fh>;
        close $fh or croak 'Cannot close scalar envdesc content';
    }
    else {
        my $env_desc_filename = $args{'envdesc_file'} // ENV_DESC_FILENAME;
        open my $fh, q{<}, $env_desc_filename or croak "Cannot open file '$env_desc_filename'";
        @env_desc_rows = <$fh>;
        close $fh or croak "Cannot close file '$env_desc_filename'";
    }

    my $desc = file_to_desc(@env_desc_rows);
    my %parameters;
    $parameters{'break_at_first_error'} = $break_at_first_error
      if defined $break_at_first_error;
    $desc->{'options'}->{'exact'} = $exact
      if defined $exact;
    my $r = assert( \%ENV, $desc, \%parameters );
    if ( !$r->{'success'} ) {
        print {*STDERR} report_errors( $r->{'errors'} )
          or croak 'Cannot print errors to STDERR';
        return 0;
    }
    return 1;
}

1;

__END__