view release on metacpan or  search on metacpan

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

=item is_glob_ref

Checks for a GLOB reference

=item is_regexp_ref, is_regex_ref, is_rx

Checks for a regular expression reference generated by the C<qr//> operator

=item is_value

Checks whether I<value> is a primitive value, i.e. a defined, non-ref, and
non-type-glob value

=item is_string

Checks whether I<value> is a string with non-zero-length contents,
equivalent to is_value($value) && length($value) > 0

=item is_number

Checks whether I<value> is a number

=item is_integer, is_int8, is_int16, is_int32, is_int64

Checks whether I<value> is an integer

=item is_undef

Checks for a undef value

=back

=head2 VOID

Void functions are introduced by the C<:void> import tag, which check
the argument type in void value and return a bool

=over 4

=item is_void

    print "Void" if is_void({});

Returns true if the structure contains useful data.
Useful data - this data is different from the value undef

=item isnt_void

    print "NOT Void" if isnt_void({foo=>undef});

Returns true if the structure does not contain any nested useful data.
Useful data - this data is different from the value undef

=back

=head2 FLAG

=over 4

=item is_false_flag

    print "Disabled" if is_false_flag("off");

If specified argument value is set to false then will be normalised to 1.

The following values will be considered as false:

    no, off, 0, false, disable

This effect is case-insensitive, i.e. both "No" or "no" will result in 1.

=item is_true_flag

    print "Enabled" if is_true_flag("on");

If specified argument value is set to true then will be normalised to 1.

The following values will be considered as true:

    yes, on, 1, true, enable

This effect is case-insensitive, i.e. both "Yes" or "yes" will result in 1.

=back

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<Data::Util::PurePerl>, L<Params::Classify>, L<Ref::Util>, L<CTK::TFVals>, L<CTK::ConfGenUtil>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C<LICENSE> file or L<https://opensource.org/license/artistic-2-0> for details

=cut

use base qw/Exporter/;
our @EXPORT = (qw/
        is_ref is_undef
        is_scalar_ref is_array_ref is_hash_ref is_code_ref
        is_glob_ref is_regexp_ref is_regex_ref is_rx
        is_value is_string is_number is_integer
        is_int8 is_int16 is_int32 is_int64
    /);

# Required
our @EXPORT_OK = (qw/
        is_void isnt_void
        is_true_flag is_false_flag
        as_array as_list as_array_ref as_hash as_hash_ref
        as_first as_first_val as_last as_last_val as_latest
    /, @EXPORT);

# 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 }
sub as_latest { goto &as_last }

1;

__END__