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 |