File Coverage

blib/lib/Data/Pool/Shared.pm
Criterion Covered Total %
statement 27 32 84.3
branch 8 14 57.1
condition 2 4 50.0
subroutine 7 8 87.5
pod 0 5 0.0
total 44 63 69.8


line stmt bran cond sub pod time code
1             package Data::Pool::Shared;
2 7     7   889028 use strict;
  7         28  
  7         258  
3 7     7   52 use warnings;
  7         27  
  7         3734  
4             our $VERSION = '0.03';
5              
6             require XSLoader;
7             XSLoader::load('Data::Pool::Shared', $VERSION);
8              
9             # Variant @ISA — inherit alloc/free/is_allocated/capacity/etc. from base
10              
11             @Data::Pool::Shared::I64::ISA = ('Data::Pool::Shared');
12             @Data::Pool::Shared::F64::ISA = ('Data::Pool::Shared');
13             @Data::Pool::Shared::I32::ISA = ('Data::Pool::Shared');
14             @Data::Pool::Shared::Str::ISA = ('Data::Pool::Shared');
15              
16             # Guard — auto-free on scope exit
17              
18             package Data::Pool::Shared::Guard {
19             sub DESTROY {
20 5     5   1542 my $self = shift;
21 5 50       22 eval { $self->[0]->free($self->[1]) } if $self->[0];
  5         25  
22             }
23             }
24              
25             sub alloc_guard {
26 1     1 0 1005 my ($self, $timeout) = @_;
27 1   50     17 my $idx = $self->alloc($timeout // -1);
28 1 50       4 return unless defined $idx;
29 1         12 my $guard = bless [$self, $idx], 'Data::Pool::Shared::Guard';
30 1 50       6 return wantarray ? ($idx, $guard) : $guard;
31             }
32              
33             sub try_alloc_guard {
34 5     5 0 8665 my ($self) = @_;
35 5         22 my $idx = $self->try_alloc;
36 5 100       31 return unless defined $idx;
37 4         12 my $guard = bless [$self, $idx], 'Data::Pool::Shared::Guard';
38 4 100       14 return wantarray ? ($idx, $guard) : $guard;
39             }
40              
41             # Convenience — alloc + set in one call
42              
43             sub alloc_set {
44 7     7 0 542001 my ($self, $val, $timeout) = @_;
45 7   50     65 my $idx = $self->alloc($timeout // -1);
46 7 50       25 return unless defined $idx;
47 7         28 $self->set($idx, $val);
48 7         17 return $idx;
49             }
50              
51             sub try_alloc_set {
52 0     0 0 0 my ($self, $val) = @_;
53 0         0 my $idx = $self->try_alloc;
54 0 0       0 return unless defined $idx;
55 0         0 $self->set($idx, $val);
56 0         0 return $idx;
57             }
58              
59             # Iterate allocated slots
60              
61             sub each_allocated {
62 2     2 0 208212 my ($self, $cb) = @_;
63 2         12 $cb->($_) for @{ $self->allocated_slots };
  2         251  
64             }
65              
66             1;
67              
68             __END__