File Coverage

inc/Test/SharedFork/Array.pm
Criterion Covered Total %
statement 30 30 100.0
branch 1 2 50.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 40 41 97.5


line stmt bran cond sub pod time code
1             #line 1
2 55     55   306 package Test::SharedFork::Array;
  55         121  
  55         1834  
3 55     55   303 use strict;
  55         111  
  55         1532  
4 55     55   280 use warnings;
  55         107  
  55         97244  
5 55     55   73676 use base 'Tie::Array';
  55         19251  
  55         13893  
6             use Storable ();
7              
8             # create new tied array
9 55     55   193 sub TIEARRAY {
10 55 50       246 my ($class, $share, $key) = @_;
11 55         346 die "missing key" unless $key;
12 55         254 my $self = bless { share => $share, key => $key }, $class;
13             $self;
14             }
15              
16              
17 1262     1262   1875 sub _get {
18 1262         3749 my $self = shift;
19 1262         4722 my $lock = $self->{share}->get_lock();
20             return $self->{share}->get($self->{key});
21             }
22 1216     1216   2134 sub FETCH {
23 1216         2862 my ($self, $index) = @_;
24             $self->_get()->[$index];
25             }
26 46     46   133 sub FETCHSIZE {
27 46         346 my $self = shift;
28 46         852 my $ary = $self->_get();
29             scalar @$ary;
30             }
31              
32 606     606   1294 sub STORE {
33             my ($self, $index, $val) = @_;
34 606         2932  
35             my $lock = $self->{share}->get_lock();
36 606         1865  
37 606         2180 my $share = $self->{share};
38 606         64452 my $cur = $share->get($self->{key});
39 606         2949 $cur->[$index] = $val;
40             $share->set($self->{key} => $cur);
41             }
42              
43             1;