File Coverage

blib/lib/Tie/StorableDir/BackedArray.pm
Criterion Covered Total %
statement 41 52 78.8
branch n/a
condition 1 3 33.3
subroutine 14 17 82.3
pod n/a
total 56 72 77.7


line stmt bran cond sub pod time code
1             package Tie::StorableDir::BackedArray;
2              
3 4     4   85 use 5.008;
  4         14  
  4         191  
4 4     4   24 use strict;
  4         6  
  4         136  
5 4     4   21 use warnings;
  4         8  
  4         126  
6              
7 4     4   5799 use base 'Tie::Array';
  4         14  
  4         9609  
8              
9             sub TIEARRAY {
10 12     12   19 my ($class, $parent, $backing) = @_;
11 12   33     47 $class = ref $class || $class;
12 12         34 my $self = [$backing, $parent];
13 12         30 bless $self, $class;
14 12         46 return $self;
15             }
16              
17             sub FETCH {
18 3     3   16 my ($self, $index) = @_;
19 3         9 return $self->[1]->translate($self->[0][$index]);
20             }
21              
22             sub FETCHSIZE {
23 7     7   29 my ($self) = @_;
24 7         8 return scalar @{$self->[0]};
  7         29  
25             }
26              
27             sub STORE {
28 1     1   3 my ($self, $index, $value) = @_;
29 1         10 $self->[0][$index] = $value;
30             }
31              
32             sub STORESIZE {
33 0     0   0 my ($self, $size) = @_;
34 0         0 @{$self->[0]} = $size;
  0         0  
35             }
36              
37             sub EXISTS {
38 1     1   3 my ($self, $index) = @_;
39 1         7 return exists $self->[0][$index];
40             }
41              
42             sub DELETE {
43 0     0   0 my ($self, $index) = @_;
44 0         0 delete $self->[0][$index];
45             }
46              
47             sub CLEAR {
48 1     1   36 my ($self) = @_;
49 1         3 @{$self->[0]} = ();
  1         12  
50             }
51              
52             sub PUSH {
53 1     1   3 my ($self, @v) = @_;
54 1         2 push @{$self->[0]}, @v;
  1         4  
55             }
56              
57             sub POP {
58 1     1   3 my $self = shift;
59 1         2 return $self->[1]->translate(pop @{$self->[0]});
  1         4  
60             }
61              
62             sub SHIFT {
63 1     1   2 my $self = shift;
64 1         2 return $self->[1]->translate(shift @{$self->[0]});
  1         4  
65             }
66              
67             sub UNSHIFT {
68 1     1   4 my ($self, @v) = @_;
69 1         2 unshift @{$self->[0]}, @v;
  1         6  
70             }
71              
72             sub SPLICE {
73 0     0     my ($this, $offset, $length, @l) = @_;
74 0           my @v = splice @{$this->[0]}, $offset, $length, @l;
  0            
75 0           @v = map { $this->[1]->translate($_) } @v;
  0            
76 0           return @v;
77             }
78              
79             1;