File Coverage

blib/lib/Devel/Spy/TieHash.pm

Criterion	Covered	Total	%
statement	24	58	41.3
branch	5	22	22.7
condition			n/a
subroutine	7	15	46.6
pod			n/a
total	36	95	37.8

package Devel::Spy::TieHash;
use strict;
use warnings;

use constant PAYLOAD => 0;
use constant CODE => 1;

sub TIEHASH {
    my $class = shift @_;

    return bless [@_], $class;
}

sub FETCH {
    my ( $self, $key ) = @_;
    $key = '' unless defined $key;

    my $value = $self->[PAYLOAD]{$key};

    my $followup = $self->[CODE]
        ->( "->{$key} -> " . ( defined $value ? $value : 'undef' ) );

    return Devel::Spy->new( $value, $followup );
}

sub STORE {
    my ( $self, $key, $value ) = @_;
    $key = '' unless defined $key;

    $self->[PAYLOAD]{$key} = $value;

    my $followup = $self->[CODE]
        ->( "->{$key} = " . ( defined $value ? $value : 'undef' ) );

    return Devel::Spy->new( $value, $followup );
}

sub DELETE {
    my ( $self, $key ) = @_;
    $key = '' unless defined $key;

    my $value = delete $self->[PAYLOAD]{$key};

    my $followup = $self->[CODE]
        ->( " delete ->{$key} ->" . ( defined $value ? $value : 'undef' ) );

    return Devel::Spy->new( $value, $followup );
}

sub CLEAR {
    my ($self) = @_;

    %{ $self->[PAYLOAD] } = ();
    $self->[CODE](' %... = ()');
    return;
}

sub EXISTS {
    my ( $self, $key ) = @_;
    $key = '' unless defined $key;

    my $value    = exists $self->[PAYLOAD]{$key};
    my $followup = $self->[CODE](" exists(->{$key}) ->" . ( defined $value ? $value : 'undef' ));

    return Devel::Spy->new( $value, $followup );
}

sub FIRSTKEY {
    my ($self) = @_;

    keys %{ $self->[PAYLOAD] };
    my $key      = each %{ $self->[PAYLOAD] };
    my $followup = $self->[CODE](" each(%...) ->" . ( defined $key ? $key : 'undef' ));
    return Devel::Spy->new( $key, $followup );
}

sub NEXTKEY {
    my ( $self, undef ) = @_;

    my $key      = each %{ $self->[PAYLOAD] };
    my $followup = $self->[CODE](" each(%...) ->" . ( defined $key ? $key : 'undef' ));
    return Devel::Spy->new( $key, $followup );
}

sub SCALAR {
    my ($self) = @_;

    my $value    = %{ $self->[PAYLOAD] };
    my $followup = $self->[CODE](" scalar(%...) ->" . ( defined $value ? $value : 'undef' ));
    return Devel::Spy->new( $value, $followup );
}

sub UNTIE {}
sub DESTROY {}

1;

__END__