File Coverage

blib/lib/PerlX/SafeNav.pm

Criterion	Covered	Total	%
statement	43	45	95.5
branch	2	4	50.0
condition			n/a
subroutine	16	18	88.8
pod	1	1	100.0
total	62	68	91.1

package PerlX::SafeNav;
use strict;
use warnings;
our $VERSION = '0.004';

use Exporter 'import';

our @EXPORT = ('$safenav', '$unsafenav');
our @EXPORT_OK = ('&safenav');

our $safenav = sub {
    my $o = shift;
    bless \$o, 'PerlX::SafeNav::Object';
};

our $unsafenav = sub {
    ${ $_[0] }
};

sub safenav (&@) {
    my ($block, $o) = @_;
    local $_ = $o->$safenav;
    $block->()->$unsafenav;
}

package PerlX::SafeNav::Object;

use overload
    '@{}' => sub {
        my $self = shift;
        tie my @a, 'PerlX::SafeNav::ArrayRef', $$self;
        return \@a;
    },
    '%{}' => sub {
        my $self = shift;
        tie my %h, 'PerlX::SafeNav::HashRef', $$self;
        return \%h;
    };

sub AUTOLOAD {
    our $AUTOLOAD;
    my $method = substr $AUTOLOAD, 2 + rindex($AUTOLOAD, '::');

    my ($self, @args) = @_;

    (defined $$self) ?
        $$self -> $method(@args) -> $safenav :
        $self;
}

sub DESTROY {}

package PerlX::SafeNav::ArrayRef;
use Tie::Array;
our @ISA = ('Tie::Array');

sub TIEARRAY {
    my ($class, $o) = @_;
    return bless \$o, $class;
}

sub FETCH {
    my ($self, $i) = @_;
    @$$self[$i] -> $safenav;
}

sub FETCHSIZE {
    my ($self) = @_;
    (defined $$self) ? @$$self : 0
}

package PerlX::SafeNav::HashRef;
use Tie::Hash;
our @ISA = ('Tie::Hash');

sub TIEHASH {
    my ($class, $o) = @_;
    bless \$o, $class;
}

sub FETCH {
    my ($self, $k) = @_;
    $$self->{$k} -> $safenav;
}

1;

__END__