view release on metacpan or  search on metacpan

lib/Acrux/RefUtil.pm  view on Meta::CPAN

# Tags
our %EXPORT_TAGS = (
        all      => [@EXPORT_OK],
        check    => [@EXPORT],
        void     => [qw/
            is_void isnt_void
        /],
        flag     => [qw/
            is_true_flag is_false_flag
        /],
        as       => [qw/
            as_array as_list as_array_ref as_hash as_hash_ref
            as_first as_first_val as_last as_last_val as_latest
        /],
    );

use constant MAX_DEPTH => 32;

# Base functions
sub is_ref { ref($_[0]) ? 1 : 0 }
sub is_undef { !defined($_[0]) }
sub is_scalar_ref { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' }
sub is_array_ref { ref($_[0]) eq 'ARRAY' }
sub is_hash_ref { ref($_[0]) eq 'HASH' }
sub is_code_ref { ref($_[0]) eq 'CODE' }
sub is_glob_ref { ref($_[0]) eq 'GLOB' }
sub is_regexp_ref { ref($_[0]) eq 'Regexp' }
sub is_regex_ref { goto &is_regexp_ref }
sub is_rx { goto &is_regexp_ref }
sub is_value { defined($_[0]) && !ref($_[0]) && ref(\$_[0]) ne 'GLOB' }
sub is_string { defined($_[0]) && !ref($_[0]) && (ref(\$_[0]) ne 'GLOB') && length($_[0]) }
sub is_number { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?(?:[Ee](?:[+-]?\d+))?$/) ? 1 : 0 }
sub is_integer { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[+-]?\d+$/) ? 1 : 0 }
sub is_int8 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,3}$/) && ($_[0] < 2**8)) ? 1 : 0 }
sub is_int16 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,5}$/) && ($_[0] < 2**16)) ? 1 : 0 }
sub is_int32 { (defined($_[0]) && !ref($_[0]) && ($_[0] =~ /^[0-9]{1,10}$/) && ($_[0] < 2**32)) ? 1 : 0 }
sub is_int64 { (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^[0-9]{1,20}$/) ? 1 : 0 }

# Extended
sub is_void {
    my $struct = shift;
    my $depth = shift || 0;
    return 1 unless defined($struct); # CATCHED! THIS IS REAL UNDEFINED VALUE
    return 0 if defined($struct) && !ref($struct); # VALUE, NOT REFERENCE
    if (is_int8($depth) && $depth > 0) {
        return 1 unless is_int8($depth);
    } else {
        return 1 unless is_int8($depth);
    }
    $depth++;
    return 0 if $depth >= MAX_DEPTH; # Exit from the recursion

    my $t = ref($struct);
    if ($t eq 'SCALAR') {
        return is_void($$struct, $depth)
    } elsif ($t eq 'ARRAY') {
        for (@$struct) {
            return 0 unless is_void($_, $depth);
        }
        return 1; # DEFINED DATA NOT FOUND - VOID
    } elsif ($t eq 'HASH') {
        return 0 if keys(%$struct);
        return 1; # DEFINED DATA NOT FOUND - VOID
    }

    # CODE, REF, GLOB, LVALUE, FORMAT, IO, VSTRING and Regexp are not supported here
    return 0; # NOT VOID
}
sub isnt_void {is_void(@_) ? 0 : 1}
sub is_true_flag {
    my $f = shift || return 0;
    return $f =~ /^(on|y|true|enable|1)/i ? 1 : 0;
}
sub is_false_flag {
    my $f = shift || return 1;
    return $f =~ /^(off|n|false|disable|0)/i ? 1 : 0;
}

# As
sub as_array_ref {
    return [] unless scalar @_; # if no args
    return [@_] if scalar(@_) > 1; # if too many args
    return [] unless defined($_[0]); # if value is undef
    if (ref($_[0]) eq 'ARRAY') { return $_[0] } # Array
    elsif (ref($_[0]) eq 'HASH') { return [%{$_[0]}] } # Hash
    return [$_[0]];
}
sub as_array {
    my $r = as_array_ref(@_);
    return wantarray ? @$r : $r;
}
sub as_list { goto &as_array }
sub as_hash_ref {
    return {} unless scalar @_; # if no args passed
    return {@_} unless scalar(@_) % 2; # if even (not odd) args passed
    return {} unless defined($_[0]); # if arg is undef
    if (ref($_[0]) eq 'HASH') { return $_[0] } # Hash
    return {};
}
sub as_hash {
    my $r = as_hash_ref(@_);
    return wantarray ? %$r : $r;
}
sub as_first {
    return undef unless defined $_[0];
    my $r = as_array_ref(@_);
    return undef unless exists($r->[0]) && defined($r->[0]);
    my $v = $r->[0];
    if (!ref($v)) { return $v } # No ref
    elsif (ref($v) eq 'SCALAR' || ref($v) eq 'REF') { return $$v } # Scalar ref
    return $v;
}
sub as_first_val { goto &as_first }
sub as_last {
    return undef unless defined $_[0];
    my $r = as_array_ref(@_);
    return undef unless exists($r->[0]) && defined($r->[0]);
    my $v = $r->[-1];
    if (!ref($v)) { return $v } # No ref
    elsif (ref($v) eq 'SCALAR' || ref($v) eq 'REF') { return $$v } # Scalar ref
    return $v;
}
sub as_last_val { goto &as_last }