File Coverage

blib/lib/IPC/Semaphore/Set/Resource.pm
Criterion Covered Total %
statement 66 79 83.5
branch 24 36 66.6
condition 2 4 50.0
subroutine 18 19 94.7
pod 0 10 0.0
total 110 148 74.3


line stmt bran cond sub pod time code
1             package IPC::Semaphore::Set::Resource;
2 4     4   16 use strict;
  4         4  
  4         95  
3 4     4   13 use warnings;
  4         5  
  4         91  
4              
5 4     4   72 use 5.008;
  4         9  
6 4     4   13 use IPC::SysV qw(SEM_UNDO IPC_NOWAIT);
  4         3  
  4         2795  
7              
8             ############
9             ## Public ##
10             ############
11              
12             sub new
13             {
14 8     8 0 7 my $class = shift;
15 8 50       21 my $args = ref($_[0]) ? $_[0] : {@_};
16             # check for required arguments.
17 8 50       16 die "'key' is required" unless defined($args->{key});
18 8 50       21 die "'number' is required" unless defined($args->{number});
19 8 50       18 die "'semaphore' is required" unless (ref($args->{semaphore}) eq 'IPC::Semaphore');
20             # 'cleanup_object' determines whether or not we'll be cleaning up in DESTROY
21 8 100       24 if (!defined($args->{cleanup_object})) {
22 6         9 $args->{cleanup_object} = 1;
23             }
24 8         11 my $self = bless($args, $class);
25             # blow up if the system doesn't have this resource in the set
26 8 50       16 if (!defined($self->value)) {
27 0         0 my $total = () = $self->semaphore->getall;
28             die $self->{number} . ' is not a valid resource for semaphore [' . $self->{key}
29 0         0 . "] which only has [$total] total resources. The resources start at 0.";
30             }
31 8         180 return bless($args, $class);
32             }
33              
34             sub lockOrDie {
35 2     2 0 4 my $self = shift;
36 2 100       7 if ($self->_lock(IPC_NOWAIT)) {
37 1         2 return 1;
38             } else {
39 1         10 die "could not lock on semaphore [$self->{key}] resource number [$self->{number}]";
40             }
41             }
42              
43             sub lockWaitTimeout
44             {
45 1     1 0 1 my $self = shift;
46 1   50     8 my $timeout = shift || 3;
47 1         1 my $lock;
48 1         2 eval {
49 1     0   11 local $SIG{ALRM} = sub { die "alarm\n" };
  0         0  
50 1         5 alarm $timeout;
51 1         3 $lock = $self->_lock;
52 1         7 alarm 0;
53             };
54 1 50       3 if (!$lock) {
55 0         0 return 0;
56             }
57 1         4 return 1;
58             }
59              
60             sub lockWaitTimeoutDie
61             {
62 1     1 0 2 my $self = shift;
63 1   50     3 my $timeout = shift || 3;
64 1         1 my $lock;
65 1         2 eval {
66 1     1   10 local $SIG{ALRM} = sub { die "alarm\n" };
  1         1000132  
67 1         5 alarm $timeout;
68 1         3 $lock = $self->_lock;
69 0         0 alarm 0;
70             };
71 1 50       9 if (!$lock) {
72 1         26 die "could not establish lock after $timeout seconds";
73             }
74 0         0 return 1;
75             }
76              
77 4 100   4 0 308 sub lock {return shift->_lock(IPC_NOWAIT) ? 1 : 0}
78 2 50   2 0 4 sub lockWait {return shift->_lock ? 1 : 0}
79 5 50   5 0 353 sub addValue {return shift->_add_value(IPC_NOWAIT) ? 1 : 0}
80              
81             ############
82             ## Helper ##
83             ############
84              
85 33     33 0 101 sub number {return shift->{number}}
86 30     30 0 64 sub semaphore {return shift->{semaphore}}
87              
88             sub value {
89 15     15 0 1971 my $self = shift;
90 15         28 return $self->semaphore->getval($self->number);
91             }
92              
93             #############
94             ## Private ##
95             #############
96              
97             sub _lock
98             {
99 10     10   24 my ($self, $flags) = @_;
100 10 100       19 if ($self->semaphore->op($self->number, -1, $flags)) {
101 5         67 $self->{_locks}++;
102 5         21 return 1;
103             }
104 3         48 return 0;
105             }
106              
107             sub _add_value
108             {
109 5     5   15 my ($self, $flags) = @_;
110 5 50       10 if ($self->semaphore->op($self->number, 1, $flags)) {
111 5         62 $self->{_locks}--;
112 5         25 return 1;
113             }
114 0         0 return 0;
115             }
116              
117             sub DESTROY
118             {
119 8     8   2135 my $self = shift;
120 8 100       26 return unless $self->{cleanup_object};
121 6 100       99 if (defined($self->{_locks})) {
122 1 50       4 if ($self->{_locks} > 0) {
123 0         0 while ($self->{_locks} > 0) {
124 0         0 $self->semaphore->op($self->number, 1, IPC_NOWAIT);
125 0         0 $self->{_locks}--;
126             }
127             }
128 1 50       38 if ($self->{_locks} < 0) {
129 0           while ($self->{_locks} < 0) {
130 0           $self->semaphore->op($self->number, -1, IPC_NOWAIT);
131 0           $self->{_locks}++;
132             }
133             }
134             }
135             }
136              
137             1;
138              
139             __END__