File Coverage

blib/lib/Util/Underscore/References.pm

Criterion	Covered	Total	%
statement	24	28	85.7
branch	27	30	90.0
condition	15	22	68.1
subroutine	16	16	100.0
pod			n/a
total	82	96	85.4

package Util::Underscore::References;

#ABSTRACT: Functions for introspecting and manipulating references

use strict;
use warnings;


## no critic (ProhibitMultiplePackages)
package    # hide from PAUSE
    _;

## no critic (RequireArgUnpacking, RequireFinalReturn, ProhibitSubroutinePrototypes)

sub ref_addr(_) {
    goto &Scalar::Util::refaddr;
}

sub ref_type(_) {
    goto &Scalar::Util::reftype;
}

BEGIN {
    # perl 5.10 thinks reftype qr// eq 'SCALAR'.
    # This is bogus, we'll have to correct that.
    if ($^V < 5.011) {
        no warnings 'redefine';
        *ref_type = sub (_) {
            my $type = &Scalar::Util::reftype;
            return 'REGEXP'
                if defined $type
                and $type eq 'SCALAR'
                and ref $_[0] eq 'Regexp';
            return $type;
        };
    }
}

sub ref_weaken(_) {
    goto &Scalar::Util::weaken;
}

sub ref_unweaken(_) {
    goto &Scalar::Util::unweaken;
}

sub ref_is_weak(_) {
    goto &Scalar::Util::isweak;
}

sub is_ref(_) {
    defined($_[0])
        && defined ref_type $_[0]
        && !defined blessed $_[0];
}

sub is_scalar_ref(_) {
    defined($_[0])
        && (
        (defined blessed $_[0])
        ? overload::Method($_[0], q[${}])
        : do {
            my $type = ref_type $_[0] // q[];
            $type eq 'SCALAR' || $type eq 'REF';
        }
        );
}

sub is_array_ref(_) {
    defined($_[0])
        && (
        (defined blessed $_[0])
        ? overload::Method($_[0], q[@{}])
        : (ref_type $_[0] // q[]) eq 'ARRAY'
        );
}

sub is_hash_ref(_) {
    defined($_[0])
        && (
        (defined blessed $_[0])
        ? overload::Method($_[0], q[%{}])
        : (ref_type $_[0] // q[]) eq 'HASH'
        );
}

sub is_code_ref(_) {
    defined($_[0])
        && (
        (defined blessed $_[0])
        ? overload::Method($_[0], q[&{}])
        : (ref_type $_[0] // q[]) eq 'CODE'
        );
}

sub is_glob_ref(_) {
    defined($_[0])
        && (
        (defined blessed $_[0])
        ? overload::Method($_[0], q[*{}])
        : (ref_type $_[0] // q[]) eq 'GLOB'
        );
}

sub is_regex(_) {
    defined(blessed $_[0])
        && ('REGEXP' eq ref_type $_[0]
        || overload::Method($_[0], q[qr]));
}

1;

__END__