File Coverage

lib/Data/Pretty/FilterContext.pm

Criterion	Covered	Total	%
statement	54	56	96.4
branch	2	2	100.0
condition	14	15	93.3
subroutine	21	22	95.4
pod	15	15	100.0
total	106	110	96.3

package Data::Pretty::FilterContext;
BEGIN
{
    use strict;
    use warnings;
    use vars qw( $VERSION );
    our $VERSION = 'v0.1.0';
};

use strict;
use warnings;

sub new {
    my($class, $obj, $oclass, $type, $ref, $pclass, $pidx, $idx) = @_;
    return bless {
        object => $obj,
        class => $ref && $oclass,
        reftype => $type,
        is_ref => $ref,
        pclass => $pclass,
        pidx => $pidx,
        idx => $idx,
    }, $class;
}

sub object_ref {
    my $self = shift;
    return $self->{object};
}

sub class {
    my $self = shift;
    return $self->{class} || "";
}

{
    no warnings 'once';
    *is_blessed = \&class;
}

sub reftype {
    my $self = shift;
    return $self->{reftype};
}

sub is_scalar {
    my $self = shift;
    return $self->{reftype} eq "SCALAR";
}

sub is_array {
    my $self = shift;
    return $self->{reftype} eq "ARRAY";
}

sub is_hash {
    my $self = shift;
    return $self->{reftype} eq "HASH";
}

sub is_code {
    my $self = shift;
    return $self->{reftype} eq "CODE";
}

sub is_ref {
    my $self = shift;
    return $self->{is_ref};
}

sub container_class {
    my $self = shift;
    return $self->{pclass} || "";
}

sub container_self {
    my $self = shift;
    return "" unless $self->{pclass};
    my $idx = $self->{idx};
    my $pidx = $self->{pidx};
    return Data::Pretty::fullname("self", [@$idx[$pidx..(@$idx - 1)]]);
}

sub expr {
    my $self = shift;
    my $top = shift || "var";
    $top =~ s/^\$//; # it's always added by fullname()
    my $idx = $self->{idx};
    return Data::Pretty::fullname($top, $idx);
}

sub object_isa {
    my($self, $class) = @_;
    return $self->{class} && $self->{class}->isa($class);
}

sub container_isa {
    my($self, $class) = @_;
    return $self->{pclass} && $self->{pclass}->isa($class);
}

sub depth {
    my $self = shift;
    return scalar @{$self->{idx}};
}

1;
# NOTE: POD
__END__