File Coverage

blib/lib/PerlX/SafeNav.pm
Criterion Covered Total %
statement 40 42 95.2
branch 2 2 100.0
condition n/a
subroutine 15 17 88.2
pod n/a
total 57 61 93.4


line stmt bran cond sub pod time code
1             package PerlX::SafeNav;
2 5     5   945127 use strict;
  5         32  
  5         146  
3 5     5   26 use warnings;
  5         11  
  5         194  
4             our $VERSION = '0.002';
5              
6 5     5   25 use Exporter 'import';
  5         13  
  5         1027  
7              
8             our @EXPORT = ('$safenav', '$unsafenav');
9              
10             our $safenav = sub {
11 20     20   17569 my $o = shift;
12 20         105 bless \$o, 'PerlX::SafeNav::Object';
13             };
14              
15             our $unsafenav = sub {
16 6     6   9 ${ $_[0] }
  6         19  
17             };
18              
19             package PerlX::SafeNav::Object;
20              
21             use overload
22             '@{}' => sub {
23 12     12   25 my $self = shift;
24 12         44 tie my @a, 'PerlX::SafeNav::ArrayRef', $$self;
25 12         64 return \@a;
26             },
27             '%{}' => sub {
28 12     12   21 my $self = shift;
29 12         45 tie my %h, 'PerlX::SafeNav::HashRef', $$self;
30 12         66 return \%h;
31 5     5   49 };
  5         17  
  5         57  
32              
33             sub AUTOLOAD {
34 35     35   57 our $AUTOLOAD;
35 35         120 my $method = substr $AUTOLOAD, 2 + rindex($AUTOLOAD, '::');
36              
37 35         66 my ($self, @args) = @_;
38              
39 35 100       262 (defined $$self) ?
40             $$self -> $method(@args) -> $safenav :
41             $self;
42             }
43              
44       0     sub DESTROY {}
45              
46             package PerlX::SafeNav::ArrayRef;
47 5     5   3346 use Tie::Array;
  5         6503  
  5         679  
48             our @ISA = ('Tie::Array');
49              
50             sub TIEARRAY {
51 12     12   30 my ($class, $o) = @_;
52 12         49 return bless \$o, $class;
53             }
54              
55             sub FETCH {
56 12     12   25 my ($self, $i) = @_;
57 12         54 @$$self[$i] -> $safenav;
58             }
59              
60             sub FETCHSIZE {
61 0     0   0 my ($self) = @_;
62 0         0 @$$self
63             }
64              
65             package PerlX::SafeNav::HashRef;
66 5     5   35 use Tie::Hash;
  5         11  
  5         654  
67             our @ISA = ('Tie::Hash');
68              
69             sub TIEHASH {
70 12     12   30 my ($class, $o) = @_;
71 12         31 bless \$o, $class;
72             }
73              
74             sub FETCH {
75 12     12   28 my ($self, $k) = @_;
76 12         76 $$self->{$k} -> $safenav;
77             }
78              
79             1;
80              
81             __END__