File Coverage

blib/lib/Scalar/In.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	40	40	100.0
condition	10	14	71.4
subroutine	5	5	100.0
pod	2	2	100.0
total	108	112	96.4

package Scalar::In; ## no critic (TidyCode)

use strict;
use warnings;
use Sub::Exporter -setup => {
    exports => [ qw( string_in numeric_in ) ],
    groups  => {
        default => [ qw( string_in ) ],
    },
};

our $VERSION = '0.002';

# using dualvars
my $true  = ! 0;
my $false = ! 1;

sub string_in (++) { ## no critic (SubroutinePrototypes)
    my ( $any1, $any2 ) = @_;

    my $ref_any1 = ref $any1;
    my @any1
        = $ref_any1 eq 'ARRAY'
        ? @{$any1}
        : $ref_any1 eq 'HASH'
        ? keys %{$any1}
        : $any1;
    for my $string ( @any1 ) {
        if ( defined $string ) {
            $string .= q{}; # stingify object
        }
        my $ref_any2 = ref $any2;
        my @any2
            = $ref_any2 eq 'ARRAY'
            ? @{$any2}
            : $ref_any2 eq 'HASH'
            ? keys %{$any2}
            : $any2;
        ITEM:
        for my $item ( @any2 ) {
            if ( ! defined $string || ! defined $item ) {
                return ! ( defined $string xor defined $item );
            }
            if ( ref $item eq 'Regexp' ) {
                $string =~ $item
                    and return $true;
                next ITEM;
            }
            ref $item eq 'CODE'
                and return $item->($string);
            $string eq q{} . $item # stingify object
                and return $true;
        }
    }

    return $false;
}

sub numeric_in (++) { ## no critic (SubroutinePrototypes)
    my ( $any1, $any2 ) = @_;

    my $ref_any1 = ref $any1;
    my @any1
        = $ref_any1 eq 'ARRAY'
        ? @{$any1}
        : $ref_any1 eq 'HASH'
        ? keys %{$any1}
        : $any1;
    for my $numeric ( @any1 ) {
        if ( defined $numeric ) {
            $numeric += 0; # numify object
        }
        my $ref_any2 = ref $any2;
        my @any2
            = $ref_any2 eq 'ARRAY'
            ? @{$any2}
            : $ref_any2 eq 'HASH'
            ? keys %{$any2}
            : $any2;
        ITEM:
        for my $item ( @any2 ) {
            if ( ! defined $numeric || ! defined $item ) {
                return ! ( defined $numeric xor defined $item );
            }
            if ( ref $item eq 'Regexp' ) {
                $numeric =~ $item
                    and return $true;
                next ITEM;
            }
            ref $item eq 'CODE'
                and return $item->($numeric);
            $numeric == ( 0 + $item ) # numify object
                and return $true;
        }
    }

    return $false;
}

# $Id$

1;

__END__