File Coverage

inc/Test/SharedFork/Array.pm
Criterion Covered Total %
statement 16 30 53.3
branch 1 2 50.0
condition n/a
subroutine 5 9 55.5
pod n/a
total 22 41 53.6


line stmt bran cond sub pod time code
1             #line 1
2 2     2   13 package Test::SharedFork::Array;
  2         5  
  2         79  
3 2     2   11 use strict;
  2         6  
  2         81  
4 2     2   11 use warnings;
  2         5  
  2         2163  
5 2     2   2682 use base 'Tie::Array';
  2         5  
  2         473  
6             use Storable ();
7              
8             # create new tied array
9 2     2   6 sub TIEARRAY {
10 2 50       7 my ($class, $share, $key) = @_;
11 2         11 die "missing key" unless $key;
12 2         8 my $self = bless { share => $share, key => $key }, $class;
13             $self;
14             }
15              
16              
17 0     0     sub _get {
18 0           my $self = shift;
19 0           my $lock = $self->{share}->get_lock();
20             return $self->{share}->get($self->{key});
21             }
22 0     0     sub FETCH {
23 0           my ($self, $index) = @_;
24             $self->_get()->[$index];
25             }
26 0     0     sub FETCHSIZE {
27 0           my $self = shift;
28 0           my $ary = $self->_get();
29             scalar @$ary;
30             }
31              
32 0     0     sub STORE {
33             my ($self, $index, $val) = @_;
34 0            
35             my $lock = $self->{share}->get_lock();
36 0            
37 0           my $share = $self->{share};
38 0           my $cur = $share->get($self->{key});
39 0           $cur->[$index] = $val;
40             $share->set($self->{key} => $cur);
41             }
42              
43             1;