File Coverage

blib/lib/Devel/CallerStack/Level.pm

Criterion	Covered	Total	%
statement	32	40	80.0
branch	14	20	70.0
condition			n/a
subroutine	7	8	87.5
pod	2	2	100.0
total	55	70	78.5

package Devel::CallerStack::Level;
use strict;
use warnings;
use Carp;

our @CARP_NOT = ( __PACKAGE__ );

our @ACCESSORS = qw/package filename line subroutine hasargs wantarray evaltext
                    is_require hints bitmask hinthash args/;

sub new {
    my $class = shift;
    my ( $depth ) = @_;
    my $self = bless( [], $class );
    package DB;
    my @caller = caller( $depth );
    return unless @caller;
    push @caller => undef unless @caller > 10;
    @$self = ( @caller, [@DB::args] );
    return $self;
}

{
    my $i = 0;
    for my $accessor ( @ACCESSORS ) {
        my $idx = $i++;
        my $sub = sub {
            my $self = shift;
            for my $check ( @_ ) {
                return unless $self->_check( $idx, $check );
            }
            return $self->[$idx];
        };
        no strict 'refs';
        *$accessor = $sub;
    }
}

sub _check {
    my $self = shift;
    my ( $idx, $check ) = @_;
    my $data = $self->[$idx];
    if( !ref( $check )) {
        return $data == $check if "$data$check" =~ m/^[\d\.e\-]+$/i;
        return "$data" eq "$check";
    }
    elsif (ref($check) eq 'Regexp') {
        return $data =~ $check ? 1 : 0;
    }
    elsif ( ref($check) eq 'CODE' ) {
        return $check->( $data );
    }
    else {
        croak( "Invalid check: $check" );
    }
}

sub check_ordered {
    my $self = shift;
    my $i = 0;
    for my $check ( @_ ) {
        next unless $self->_check( $i++, $check );
        return unless wantarray;
        return ( 0, $ACCESSORS[$i], $i );
    }
    return 1;
}

1;

__END__