line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package POE::Component::ResourcePool::Resource; |
4
|
1
|
|
|
1
|
|
29533
|
use Moose::Role; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
use Set::Object::Weak; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#use MooseX::Types::Set::Object; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub could_allocate { |
11
|
|
|
|
|
|
|
my ( $self, $pool, $request ) = @_; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
return 1; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
requires "try_allocating"; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
requires "finalize_allocation"; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
requires "free_allocation"; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub forget_request { |
23
|
|
|
|
|
|
|
my ( $self, $pool, $request ) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
return; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub register_request { |
29
|
|
|
|
|
|
|
my ( $self, $pool, $request ) = @_; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
return; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub notify_all_pools { |
35
|
|
|
|
|
|
|
my $self = shift; |
36
|
|
|
|
|
|
|
$_->resource_updated($self) for $self->registered_pools; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
has _registered_pools => ( |
40
|
|
|
|
|
|
|
#isa => "Set::Object", |
41
|
|
|
|
|
|
|
is => "ro", |
42
|
|
|
|
|
|
|
init_arg => undef, |
43
|
|
|
|
|
|
|
default => sub { Set::Object::Weak->new }, |
44
|
|
|
|
|
|
|
handles => { |
45
|
|
|
|
|
|
|
registered_pools => "members", |
46
|
|
|
|
|
|
|
register_pool => "insert", |
47
|
|
|
|
|
|
|
unregister_pool => "remove", |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
__PACKAGE__; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
__END__ |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=pod |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 NAME |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
POE::Component::ResourcePool::Resource - base role for resources. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 SYNOPSIS |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
package MyResource; |
64
|
|
|
|
|
|
|
use Moose; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
with qw(POE::Component::ResourcePool::Resource); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub could_allocate { |
69
|
|
|
|
|
|
|
my ( $self, $pool, $request, $value ) = @_; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
if ( $self->could_never_allocate($value) ) { |
72
|
|
|
|
|
|
|
return; |
73
|
|
|
|
|
|
|
} else { |
74
|
|
|
|
|
|
|
return 1; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub try_allocating { |
79
|
|
|
|
|
|
|
my ( $self, $pool, $request, $value ) = @_; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
if ( $self->can_allocate_right_now($value) ) { |
82
|
|
|
|
|
|
|
return @allocation; # anything, but usually $value |
83
|
|
|
|
|
|
|
} else { |
84
|
|
|
|
|
|
|
return; # empty list denotes failure |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub finalize_allocation { |
89
|
|
|
|
|
|
|
my ( $self, $pool, $request, @allocation ) = @_; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
... |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
return $param; # the actual parameter to be given back to the resource |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub free_allocation { |
97
|
|
|
|
|
|
|
my ( $self, $pool, $request, @allocation ) = @_; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 DESCRIPTION |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
This role provides an API for abstract asynchroneous resource allocation. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Resource allocation is performed via a two step process, the first step is to |
106
|
|
|
|
|
|
|
attempt allocation noncomittally, and the second is to finalize an allocation. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Finalization is guaranteed to happen atomically with respect to allocation |
109
|
|
|
|
|
|
|
attempts, for a given resource, but if allocation of another resource fails |
110
|
|
|
|
|
|
|
then the request will not finalize the allocation. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
All the values involved are completely arbitrary, but they are managed by the |
113
|
|
|
|
|
|
|
resource pool in order to relief resources of the task of tracking requests and |
114
|
|
|
|
|
|
|
their allocations themselves. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 METHODS |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=over 4 |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item could_allocate $pool, $request, $value |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Check if the C<$value> specified in the given C<$request> object could ever be |
123
|
|
|
|
|
|
|
allocated. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
The default implementation will return true. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
The purpose of this method is to allow unfulfillable resources to generate an |
128
|
|
|
|
|
|
|
error when they are queued. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
For example a request that tries to allocate a value from a semaphore resource, |
131
|
|
|
|
|
|
|
that is bigger than the semaphore's initial value should return an error. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=item try_allocating $pool, $request, $value |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
This method should return a non empty list (typically the $value) if $value can |
136
|
|
|
|
|
|
|
be presently allocated. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
The list will only ever be used to pass back into C<finalize_allocation> and |
139
|
|
|
|
|
|
|
C<free_allocation>, and nothing else, so it is considered effectively private |
140
|
|
|
|
|
|
|
to the resource. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
For an example of why allocation data structures are private see |
143
|
|
|
|
|
|
|
L<POE::Component::ResourcePool::Resource::TryList> (it needs to keep track of |
144
|
|
|
|
|
|
|
which resource the allocation was delegated too, for instance). |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item finalize_allocation $request, @allocation |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Denotes that the allocation that has previously been successfully tried should |
149
|
|
|
|
|
|
|
be comitted to the resource and made final. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
This is assumed to never fail. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
The return value is passed as a parameter to the request, and not used for |
154
|
|
|
|
|
|
|
anything else. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item free_allocation $pool, $request, @allocation |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Frees an allocation that has been previously finalized. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
This method should notify all registered pools if subsequently failed |
161
|
|
|
|
|
|
|
allocations could now succeed. Even the pool which has freed the allocation |
162
|
|
|
|
|
|
|
does not assume new allocations may be attempted yet. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Calling C<notify_all_pools> should suffice. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=item notify_all_pools |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
A convenience method that will call C<resource_updated> for every pool in the |
169
|
|
|
|
|
|
|
C<registered_pools> list. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item registered_pools |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Returns the list of registered pools, as maintained by C<register_pool> and |
174
|
|
|
|
|
|
|
C<unregister_pool>. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
No order guarantees are provided, but this may change in the if prioritization |
177
|
|
|
|
|
|
|
is introduced. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
This list should be used to send update notifications when the resource is |
180
|
|
|
|
|
|
|
updated. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=item register_pool $pool |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item unregister_pool $pool |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Keep track of pools that are using this resource. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
The default implementation uses a wek L<Set::Object> internally. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
It is reccomended you do not override this implementation, because in the |
191
|
|
|
|
|
|
|
future the API may be extended to allow prioritization of pools. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=item register_request $pool, $request |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=item forget_request $pool, $request |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
These are advisory methods that inform the resource when a request starts and |
198
|
|
|
|
|
|
|
stops becoming relevant to it. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
In order to optimize resource update notifications, especially when updates are |
201
|
|
|
|
|
|
|
continual, a resource may choose to keep track of previously attempted values |
202
|
|
|
|
|
|
|
weakly indexed by the request that asked for them (in C<try_allocating>). |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
If the request is canceled or fulfilled (possibly by some other resource) the |
205
|
|
|
|
|
|
|
pool will notify all involved resources that they can remove it from their data |
206
|
|
|
|
|
|
|
structures. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
The base implementation is a noop, as no tracking is provided by default. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
See the L<POE::Component::ResourcePool::Resource::TokenBucket> resource for an |
211
|
|
|
|
|
|
|
example of how to use this (it notifies based on delays). |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=back |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=cut |
216
|
|
|
|
|
|
|
|