File Coverage

blib/lib/Debug/Helper/Flag.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	17	24	70.8
condition	1	3	33.3
subroutine	6	7	85.7
pod			n/a
total	65	77	84.4

package Debug::Helper::Flag;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.03';

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(DEBUG_FLAG);

use Carp;

our $strict = $ENV{PERL_DEBUG_HELPER_FLAG_STRICT};

my $Value;

sub import {
  my $caller = shift;
  my @args = @_;

  croak("Too many args") if @args > 3;

  my $exp;
  if (@args % 2) {
    $exp = shift(@args) // croak("Undefined module argument");
    $exp eq 'DEBUG_FLAG' or croak("'$exp': invalid module argument");
  }
  my ($want_define, $val);
  if (@args) {
    croak("Undefined module argument") if !defined($args[0]);
    croak("'$args[0]': invalid module argument") if $args[0] ne 'DEBUG_FLAG';
    $want_define = 1;
    $val = !!$args[1];
  }
  if ($want_define) {
    if (defined($Value)) {
      croak("Attempt to redefine DEBUG_FLAG with different value") if $val ne $Value;
    }
    else {
      $Value = $val;
      {
        no strict 'refs';         ## no critic (ProhibitNoStrict)
        my $const_val = $val;
        *{__PACKAGE__ . "::DEBUG_FLAG"} = sub () {$const_val};
      }
    }
  }
  if ($exp) {
    if (!defined($Value)) {
      state $msg = "Attempt to export while constant is not yet defined";
      if ($strict) {
        croak($msg);
      } else {
        carp($msg);
      }
    }
    __PACKAGE__->export_to_level(1, $caller, $exp)
  }
}



1; # End of Debug::Helper::Flag


__END__