File Coverage

blib/lib/Net/IPAddress/Util/Collection/Tie.pm
Criterion Covered Total %
statement 33 71 46.4
branch 2 18 11.1
condition 1 11 9.0
subroutine 10 18 55.5
pod 1 1 100.0
total 47 119 39.5


line stmt bran cond sub pod time code
1             package Net::IPAddress::Util::Collection::Tie;
2              
3 5     5   27 use strict;
  5         46  
  5         124  
4 5     5   29 use warnings;
  5         9  
  5         108  
5 5     5   64 use 5.012;
  5         15  
6              
7 5     5   24 use Carp qw( confess );
  5         6  
  5         3704  
8              
9             require Net::IPAddress::Util;
10              
11             sub new {
12 46     46 1 67 my $class = shift;
13 46   33     144 $class = ref($class) || $class;
14 46         66 my ($arg_ref) = @_;
15 46         161 return bless $arg_ref => $class;
16             }
17              
18             sub TIEARRAY {
19 46     46   87 my ($class, $contents) = @_;
20 46 50       87 $contents = [] unless defined $contents;
21 46         61 @{$contents} = map { _checktype($_) } @{$contents};
  46         68  
  42         58  
  46         77  
22 46         166 my $self = $class->new({ contents => $contents });
23             }
24              
25             sub FETCH {
26 258     258   354 my ($self, $i) = @_;
27 258         504 return $self->{ contents }->[ $i ];
28             }
29              
30             sub STORE {
31 0     0   0 my ($self, $i, $v) = @_;
32 0         0 $self->{ contents }->[ $i ] = _checktype($v);
33 0         0 return $v;
34             }
35              
36             sub FETCHSIZE {
37 56     56   115 my ($self) = @_;
38 56         65 return scalar @{$self->{ contents }};
  56         182  
39             }
40              
41             sub EXISTS {
42 0     0   0 my ($self, $i) = @_;
43 0         0 return exists $self->{ contents }->[ $i ];
44             }
45              
46             sub DELETE {
47 0     0   0 my ($self, $i) = @_;
48 0         0 return delete $self->{ contents }->[ $i ];
49             }
50              
51             sub CLEAR {
52 0     0   0 my ($self) = @_;
53 0         0 $self->{ contents } = [ ];
54 0         0 return $self->{ contents };
55             }
56              
57             sub PUSH {
58 68     68   132 my ($self, @l) = @_;
59 68         78 push @{$self->{ contents }}, map { _checktype($_) } @l;
  68         122  
  180         280  
60             }
61              
62             sub POP {
63 0     0   0 my ($self) = @_;
64 0         0 return pop @{$self->{ contents }};
  0         0  
65             }
66              
67             sub UNSHIFT {
68 0     0   0 my ($self, @l) = @_;
69 0         0 unshift @{$self->{ contents }}, map { _checktype($_) } @l;
  0         0  
  0         0  
70             }
71              
72             sub SHIFT {
73 0     0   0 my ($self) = @_;
74 0         0 return shift @{$self->{ contents }};
  0         0  
75             }
76              
77             sub SPLICE {
78 0     0   0 my ($self, $offset, $length, @l) = @_;
79 0 0       0 $offset = 0 unless defined $offset;
80 0 0       0 $length = $self->FETCHSIZE() - $offset unless defined $length;
81 0         0 return splice @{$self->{ contents }}, $offset, $length, map { _checktype($_) } @l;
  0         0  
  0         0  
82             }
83              
84             sub _checktype {
85 222     222   292 my ($v) = @_;
86 222 50       666 return $v if ref($v) eq 'Net::IPAddress::Util::Range';
87 0 0         if (ref($v) eq 'HASH') {
88 0           eval { $v = Net::IPAddress::Util::Range->new($v) };
  0            
89             }
90 0 0 0       if (!ref($v) or ref($v) eq 'ARRAY') {
91 0           eval { $v = Net::IPAddress::Util->new($v) };
  0            
92             }
93 0 0         if (ref($v) eq 'Net::IPAddress::Util') {
94 0           $v = Net::IPAddress::Util::Range->new({ ip => $v });
95             }
96 0 0 0       if (!defined($v) or ref($v) ne 'Net::IPAddress::Util::Range') {
97 0 0 0       my $disp = defined($v) ? (ref($v) || 'bare scalar') : 'undef()';
98 0           confess("Invalid data type ($disp)");
99             }
100 0           return $v;
101             }
102              
103             1;
104              
105             __END__