File Coverage

blib/lib/Thread/CriticalSection.pm
Criterion Covered Total %
statement 9 25 36.0
branch 0 6 0.0
condition n/a
subroutine 3 5 60.0
pod 2 2 100.0
total 14 38 36.8


line stmt bran cond sub pod time code
1             package Thread::CriticalSection;
2              
3 1     1   24376 use warnings;
  1         3  
  1         30  
4 1     1   7 use strict;
  1         2  
  1         33  
5 1     1   914 use Thread::Semaphore;
  1         18636  
  1         232  
6              
7             our $VERSION = '0.02';
8              
9              
10             sub new {
11 0     0 1   my $class = shift;
12            
13 0           return bless {
14             sem => Thread::Semaphore->new,
15             }, $class;
16             }
17              
18              
19             sub execute {
20 0     0 1   my ($self, $sub) = @_;
21 0           my $sem = $self->{sem};
22            
23 0           my $wantarray = wantarray;
24 0           my @result;
25            
26 0           $sem->down;
27            
28 0           eval {
29 0 0         if ($wantarray) { @result = $sub->() }
  0            
30 0           else { $result[0] = $sub->() }
31             };
32              
33 0           my $e = $@;
34 0           $sem->up;
35            
36 0 0         die $e if $e;
37            
38 0 0         return @result if $wantarray;
39 0           return $result[0];
40             }
41              
42              
43             42; # End of Thread::CriticalSection
44              
45              
46             =head1 NAME
47              
48             Thread::CriticalSection - Run a coderef inside a critical section
49              
50             =head1 VERSION
51              
52             Version 0.02
53              
54             =head1 SYNOPSIS
55              
56             use threads;
57             use Thread::CriticalSection;
58            
59             my $cs = Thread::CriticalSection->new;
60            
61             $cs->execute(sub {
62             # your code is protected by $cs
63             });
64            
65             # you can also return stuff
66             my $result = $cs->execute(sub {
67             # do work in a cosy critical section
68             return $result;
69             });
70            
71             # and you can even use wantarray
72             my @victims = $cs->execute(sub {
73             # do work in a cosy critical section
74             return wantarray? @result : \@result;
75             });
76              
77              
78             =head1 STATUS
79              
80             As of 2008/06/18, this module is considered beta quality. The interface
81             should not suffer any changes but its a young module with very little use.
82              
83             You'll still see "Scalars leaked" in the test suite, and I would like to
84             get rid of them before declaring the code as stable.
85              
86             The abnormal thread terminations I get when running the test suite are
87             in the unsafe tests, so I think I'm getting into perl threads issues,
88             not bugs in this module. Prof of the opposite (in the form of failing
89             tests) are most welcome.
90              
91              
92             =head1 DESCRIPTION
93              
94             The Thread::CriticalSection module allows you to run a coderef inside a
95             critical section.
96              
97             All the details of entering and leaving the critical section are taken care
98             of by the C method.
99              
100             You can have several critical sections simultaneously inside your program.
101             The usual care and feeding regarding deadlocks should be taken when calling
102             C recursively.
103              
104              
105             =head1 METHODS
106              
107             =over 4
108              
109             =item * $cs = new()
110              
111             Creates and returns a new critical section. Requires no parameters.
112              
113              
114             =item * [$return|@return] = $cs->execute(sub {}|$coderef)
115              
116             Executes the given $coderef inside the critical section. The $coderef
117             can use wantarray to inspect the context of the call and react
118             accordingly.
119              
120              
121             =back
122              
123              
124             =head1 AUTHOR
125              
126             Pedro Melo, C<< >>
127              
128              
129             =head1 DEVELOPMENT
130              
131             You can find the source for this module at
132             L.
133              
134              
135             =head1 BUGS
136              
137             Please report any bugs or feature requests to C, or through
138             the web interface at L. I will be notified, and then you'll
139             automatically be notified of progress on your bug as I make changes.
140              
141              
142             =head1 SUPPORT
143              
144             You can find documentation for this module with the perldoc command.
145              
146             perldoc Thread::CriticalSection
147              
148              
149             You can also look for information at:
150              
151             =over 4
152              
153             =item * RT: CPAN's request tracker
154              
155             L
156              
157             =item * AnnoCPAN: Annotated CPAN documentation
158              
159             L
160              
161             =item * CPAN Ratings
162              
163             L
164              
165             =item * Search CPAN
166              
167             L
168              
169             =back
170              
171              
172             =head1 COPYRIGHT & LICENSE
173              
174             Copyright 2008 Pedro Melo, all rights reserved.
175              
176             This program is free software; you can redistribute it and/or modify it
177             under the same terms as Perl itself.
178              
179              
180             =cut