line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Redis::JobQueue::Job; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Redis::JobQueue::Job - Object interface for creating and manipulating jobs |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 VERSION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
This documentation refers to C version 1.18 |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=cut |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#-- Pragmas -------------------------------------------------------------------- |
14
|
|
|
|
|
|
|
|
15
|
68
|
|
|
68
|
|
114099
|
use 5.010; |
|
68
|
|
|
|
|
175
|
|
16
|
68
|
|
|
68
|
|
229
|
use strict; |
|
68
|
|
|
|
|
84
|
|
|
68
|
|
|
|
|
1115
|
|
17
|
68
|
|
|
68
|
|
186
|
use warnings; |
|
68
|
|
|
|
|
71
|
|
|
68
|
|
|
|
|
2414
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# ENVIRONMENT ------------------------------------------------------------------ |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '1.18'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
#-- load the modules ----------------------------------------------------------- |
24
|
|
|
|
|
|
|
|
25
|
68
|
|
|
|
|
2718
|
use Exporter qw( |
26
|
|
|
|
|
|
|
import |
27
|
68
|
|
|
68
|
|
219
|
); |
|
68
|
|
|
|
|
71
|
|
28
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
29
|
|
|
|
|
|
|
STATUS_CREATED |
30
|
|
|
|
|
|
|
STATUS_WORKING |
31
|
|
|
|
|
|
|
STATUS_COMPLETED |
32
|
|
|
|
|
|
|
STATUS_FAILED |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
#-- load the modules ----------------------------------------------------------- |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Modules |
38
|
68
|
|
|
68
|
|
249
|
use Carp; |
|
68
|
|
|
|
|
73
|
|
|
68
|
|
|
|
|
3225
|
|
39
|
68
|
|
|
|
|
3138
|
use List::Util qw( |
40
|
|
|
|
|
|
|
min |
41
|
68
|
|
|
68
|
|
250
|
); |
|
68
|
|
|
|
|
68
|
|
42
|
68
|
|
|
68
|
|
2400
|
use Mouse; # automatically turns on strict and warnings |
|
68
|
|
|
|
|
120354
|
|
|
68
|
|
|
|
|
441
|
|
43
|
68
|
|
|
68
|
|
20136
|
use Mouse::Util::TypeConstraints; |
|
68
|
|
|
|
|
76
|
|
|
68
|
|
|
|
|
360
|
|
44
|
68
|
|
|
|
|
2942
|
use Params::Util qw( |
45
|
|
|
|
|
|
|
_HASH0 |
46
|
|
|
|
|
|
|
_INSTANCE |
47
|
68
|
|
|
68
|
|
8294
|
); |
|
68
|
|
|
|
|
19639
|
|
48
|
68
|
|
|
68
|
|
2837
|
use Time::HiRes qw(); |
|
68
|
|
|
|
|
5301
|
|
|
68
|
|
|
|
|
1974
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#-- declarations --------------------------------------------------------------- |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 SYNOPSIS |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
There are several ways to create a C |
55
|
|
|
|
|
|
|
object: |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $pre_job = { |
58
|
|
|
|
|
|
|
id => '4BE19672-C503-11E1-BF34-28791473A258', |
59
|
|
|
|
|
|
|
queue => 'lovely_queue', |
60
|
|
|
|
|
|
|
job => 'strong_job', |
61
|
|
|
|
|
|
|
expire => 12*60*60, # 12h |
62
|
|
|
|
|
|
|
status => STATUS_CREATED, |
63
|
|
|
|
|
|
|
workload => \'Some stuff up to 512MB long', |
64
|
|
|
|
|
|
|
result => \'JOB result comes here, up to 512MB long', |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $job = Redis::JobQueue::Job->new( |
68
|
|
|
|
|
|
|
id => $pre_job->{id}, |
69
|
|
|
|
|
|
|
queue => $pre_job->{queue}, |
70
|
|
|
|
|
|
|
job => $pre_job->{job}, |
71
|
|
|
|
|
|
|
expire => $pre_job->{expire}, |
72
|
|
|
|
|
|
|
status => $pre_job->{status}, |
73
|
|
|
|
|
|
|
workload => $pre_job->{workload}, |
74
|
|
|
|
|
|
|
result => $pre_job->{result}, |
75
|
|
|
|
|
|
|
); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$job = Redis::JobQueue::Job->new( $pre_job ); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
my $next_job = Redis::JobQueue::Job->new( $job ); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Access methods to read and assign the relevant attributes of the object. |
82
|
|
|
|
|
|
|
For example: |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$job->$workload( \'New workload' ); |
85
|
|
|
|
|
|
|
# or |
86
|
|
|
|
|
|
|
$job->$workload( 'New workload' ); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
my $id = $job->id; |
89
|
|
|
|
|
|
|
# 'workload' and 'result' return a reference to the data |
90
|
|
|
|
|
|
|
my $result = ${ $job->result }; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Returns a list of names of the modified object fields: |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
my @modified = $job->modified_attributes; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Resets the sign of changing an attribute. For example: |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
$job->clear_modified( qw( status ) ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 DESCRIPTION |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Job API is implemented by C class. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
The main features of the C class are: |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=over 3 |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=item * |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Provides an object oriented model of communication. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=item * |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Supports data representing various aspects of the job. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item * |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Supports the creation of the job object, an automatic allowance for the change |
119
|
|
|
|
|
|
|
attributes and the ability to cleanse the signs of change attributes. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=back |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 EXPORT |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
None by default. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
The following additional constants, defining defaults for various parameters, are available for export: |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=over |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=item C |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Initial status of the job, showing that it was created. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=cut |
136
|
68
|
|
|
68
|
|
211
|
use constant STATUS_CREATED => '__created__'; |
|
68
|
|
|
|
|
67
|
|
|
68
|
|
|
|
|
3504
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item C |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Jobs is being executed. Set by the worker function. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
68
|
|
|
68
|
|
238
|
use constant STATUS_WORKING => '__working__'; |
|
68
|
|
|
|
|
99
|
|
|
68
|
|
|
|
|
2800
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item C |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Job is completed. Set by the worker function. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
68
|
|
|
68
|
|
228
|
use constant STATUS_COMPLETED => '__completed__'; |
|
68
|
|
|
|
|
126
|
|
|
68
|
|
|
|
|
2610
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item C |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Job has failed. Set by the worker function. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=cut |
157
|
68
|
|
|
68
|
|
265
|
use constant STATUS_FAILED => '__failed__'; |
|
68
|
|
|
|
|
121
|
|
|
68
|
|
|
|
|
91504
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=back |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
User himself should specify the status L STATUS_WORKING>, L STATUS_COMPLETED>, L STATUS_FAILED> |
162
|
|
|
|
|
|
|
or own status when processing the job. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=cut |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $meta = __PACKAGE__->meta; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
subtype __PACKAGE__.'::NonNegInt', |
169
|
|
|
|
|
|
|
as 'Int', |
170
|
|
|
|
|
|
|
where { $_ >= 0 }, |
171
|
|
|
|
|
|
|
message { ( $_ || '' ).' is not a non-negative integer!' }, |
172
|
|
|
|
|
|
|
; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
subtype __PACKAGE__.'::NonNegNum', |
175
|
|
|
|
|
|
|
as 'Num', |
176
|
|
|
|
|
|
|
where { $_ >= 0 }, |
177
|
|
|
|
|
|
|
message { ( $_ || '' ).' is not a non-negative number!' }, |
178
|
|
|
|
|
|
|
; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
subtype __PACKAGE__.'::Progress', |
181
|
|
|
|
|
|
|
as 'Num', |
182
|
|
|
|
|
|
|
where { $_ >= 0 and $_ <= 1 }, |
183
|
|
|
|
|
|
|
message { ( $_ || '' ).' is not a progress number!' }, |
184
|
|
|
|
|
|
|
; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
subtype __PACKAGE__.'::WOSpStr', |
187
|
|
|
|
|
|
|
as 'Str', |
188
|
|
|
|
|
|
|
where { $_ !~ / / }, |
189
|
|
|
|
|
|
|
message { ( $_ || '' ).' contains spaces!' }, |
190
|
|
|
|
|
|
|
; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
subtype __PACKAGE__.'::DataRef', |
193
|
|
|
|
|
|
|
as 'ScalarRef' |
194
|
|
|
|
|
|
|
; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
coerce __PACKAGE__.'::DataRef', |
197
|
|
|
|
|
|
|
from 'Str', |
198
|
|
|
|
|
|
|
via { \$_ }, |
199
|
|
|
|
|
|
|
; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#-- constructor ---------------------------------------------------------------- |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head2 CONSTRUCTOR |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
An error will cause the program to halt if the argument is not valid. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head3 C $uuid, ... )> |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
It generates a Job object and can be called as either a class method or |
210
|
|
|
|
|
|
|
an object method. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
If invoked with the first argument being an object of C class |
213
|
|
|
|
|
|
|
or a reference to a hash, then the new object attribute values are taken from |
214
|
|
|
|
|
|
|
the hash of the first argument. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
C optionally takes arguments. These arguments are in key-value pairs. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
This example illustrates a C call with all the valid arguments: |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
$job = Redis::JobQueue::Job->new( |
221
|
|
|
|
|
|
|
id => '4BE19672-C503-11E1-BF34-28791473A258', |
222
|
|
|
|
|
|
|
# UUID string, using conventional UUID string format. |
223
|
|
|
|
|
|
|
# Do not use it because filled in automatically when |
224
|
|
|
|
|
|
|
# you create a job. |
225
|
|
|
|
|
|
|
queue => 'lovely_queue', # The name of the job queue. |
226
|
|
|
|
|
|
|
# (required) |
227
|
|
|
|
|
|
|
job => 'strong_job', # The name of the job. |
228
|
|
|
|
|
|
|
# (optional attribute) |
229
|
|
|
|
|
|
|
expire => 12*60*60, # Job's time to live in seconds. |
230
|
|
|
|
|
|
|
# 0 for no expire time. |
231
|
|
|
|
|
|
|
# (required) |
232
|
|
|
|
|
|
|
status => STATUS_CREATED, # Current status of the job. |
233
|
|
|
|
|
|
|
# Do not use it because value should be set by the worker. |
234
|
|
|
|
|
|
|
workload => \'Some stuff up to 512MB long', |
235
|
|
|
|
|
|
|
# Baseline data for the function of the worker |
236
|
|
|
|
|
|
|
# (the function name specified in the 'job'). |
237
|
|
|
|
|
|
|
# Can be a scalar, an object or a reference to a scalar, hash, or array |
238
|
|
|
|
|
|
|
result => \'JOB result comes here, up to 512MB long', |
239
|
|
|
|
|
|
|
# The result of the function of the worker |
240
|
|
|
|
|
|
|
# (the function name specified in the 'job'). |
241
|
|
|
|
|
|
|
# Do not use it because value should be set by the worker. |
242
|
|
|
|
|
|
|
); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Returns the object itself, we can chain settings. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
The attributes C and C may contain a large amount of data, |
247
|
|
|
|
|
|
|
therefore, it is desirable that they be passed as references to the actual |
248
|
|
|
|
|
|
|
data to improve performance. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Do not use spaces in an C attribute value. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Each element in the struct data has an accessor method, which is |
253
|
|
|
|
|
|
|
used to assign and fetch the element's value. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=cut |
256
|
|
|
|
|
|
|
around BUILDARGS => sub { |
257
|
|
|
|
|
|
|
my $orig = shift; |
258
|
|
|
|
|
|
|
my $class = shift; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
if ( _INSTANCE( $_[0], __PACKAGE__ ) ) { |
261
|
|
|
|
|
|
|
my $job = shift; |
262
|
|
|
|
|
|
|
return $class->$orig( ( map { ( $_, $job->$_ ) } $job->job_attributes ), @_ ); |
263
|
|
|
|
|
|
|
} else { |
264
|
|
|
|
|
|
|
return $class->$orig( @_ ); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
}; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
#-- public attributes ---------------------------------------------------------- |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=head2 METHODS |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
An error will cause the program to halt if the argument is not valid. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=head3 C |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head3 C |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head3 C |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head3 C |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=head3 C |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=head3 C |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head3 C |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
The family of methods for a multitude of accessor methods for your data with |
289
|
|
|
|
|
|
|
the appropriate names. These methods are able to read and assign the relevant |
290
|
|
|
|
|
|
|
attributes of the object. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
As attributes C and C may contain a large amount of data |
293
|
|
|
|
|
|
|
(scalars, references to arrays and hashes, objects): |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=over 3 |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=item * |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
A read method returns a reference to the data. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item * |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
A write method can receive both data or a reference to the data. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=back |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=cut |
308
|
|
|
|
|
|
|
has 'id' => ( |
309
|
|
|
|
|
|
|
is => 'rw', |
310
|
|
|
|
|
|
|
isa => __PACKAGE__.'::WOSpStr', |
311
|
|
|
|
|
|
|
default => '', |
312
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'id' ) }, |
313
|
|
|
|
|
|
|
); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
has 'queue' => ( |
316
|
|
|
|
|
|
|
is => 'rw', |
317
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
318
|
|
|
|
|
|
|
required => 1, |
319
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'queue' ) }, |
320
|
|
|
|
|
|
|
); |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
has 'job' => ( |
323
|
|
|
|
|
|
|
is => 'rw', |
324
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
325
|
|
|
|
|
|
|
default => '', |
326
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'job' ) }, |
327
|
|
|
|
|
|
|
); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
has 'status' => ( |
330
|
|
|
|
|
|
|
is => 'rw', |
331
|
|
|
|
|
|
|
isa => 'Str', |
332
|
|
|
|
|
|
|
default => STATUS_CREATED, |
333
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'status', $_[1] ) }, |
334
|
|
|
|
|
|
|
); |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
has 'expire' => ( |
337
|
|
|
|
|
|
|
is => 'rw', |
338
|
|
|
|
|
|
|
isa => 'Maybe['.__PACKAGE__.'::NonNegInt]', |
339
|
|
|
|
|
|
|
required => 1, |
340
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'expire' ) }, |
341
|
|
|
|
|
|
|
); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
for my $name ( qw( workload result ) ) { |
344
|
|
|
|
|
|
|
has $name => ( |
345
|
|
|
|
|
|
|
is => 'rw', |
346
|
|
|
|
|
|
|
# A reference because attribute can contain a large amount of data |
347
|
|
|
|
|
|
|
isa => __PACKAGE__.'::DataRef | HashRef | ArrayRef | ScalarRef | Object', |
348
|
|
|
|
|
|
|
coerce => 1, |
349
|
|
|
|
|
|
|
builder => '_build_data', # will throw an error if you pass a bare non-subroutine reference as the default |
350
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( $name ) }, |
351
|
|
|
|
|
|
|
); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=head3 C |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
Optional attribute, the progress of the task, |
357
|
|
|
|
|
|
|
contains a user-defined value from 0 to 1. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=cut |
360
|
|
|
|
|
|
|
has 'progress' => ( |
361
|
|
|
|
|
|
|
is => 'rw', |
362
|
|
|
|
|
|
|
isa => __PACKAGE__.'::Progress', |
363
|
|
|
|
|
|
|
default => 0, |
364
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'progress' ) }, |
365
|
|
|
|
|
|
|
); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head3 C |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
Optional attribute, a string message with additional user-defined information. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=cut |
372
|
|
|
|
|
|
|
has 'message' => ( |
373
|
|
|
|
|
|
|
is => 'rw', |
374
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
375
|
|
|
|
|
|
|
default => '', |
376
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( 'message' ) }, |
377
|
|
|
|
|
|
|
); |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=head3 C |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
Returns time of job creation. |
382
|
|
|
|
|
|
|
Set to the current time (C) when job is created. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
If necessary, alternative value can be set as: |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
$job->created( time ); |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head3 C |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Returns the time of the most recent modification of the job. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Set to the current time (C) when value(s) of any of the following data changes: |
393
|
|
|
|
|
|
|
L, L, L, L, L, L, L. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
Can be updated manually: |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
$job->updated( time ); |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=cut |
400
|
|
|
|
|
|
|
for my $name ( qw( created updated ) ) { |
401
|
|
|
|
|
|
|
has $name => ( |
402
|
|
|
|
|
|
|
is => 'rw', |
403
|
|
|
|
|
|
|
isa => __PACKAGE__.'::NonNegNum', |
404
|
|
|
|
|
|
|
default => sub { Time::HiRes::time }, |
405
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( $name ) }, |
406
|
|
|
|
|
|
|
); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head3 C |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Returns the time that the job started processing. |
412
|
|
|
|
|
|
|
Set to the current time (C) when the L of the job is set to L. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
If necessary, you can set your own value, for example: |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
$job->started( time ); |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head3 C |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Returns the time of the task completion. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
It is set to 0 when task is created. |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Set to C when L is changed to L. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Can be modified manually: |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
$job->completed( time ); |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Change the C attribute sets C = 0. |
431
|
|
|
|
|
|
|
The attributes C and C are mutually exclusive. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head3 C |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Returns the time of the task failure. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
It is set to 0 when task is created. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
Set to C when L is changed to L. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Can be modified manually: |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
$job->failed( time ); |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Change the C attribute sets C = 0. |
446
|
|
|
|
|
|
|
The attributes C and C are mutually exclusive. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=cut |
449
|
|
|
|
|
|
|
for my $name ( qw( started completed failed ) ) { |
450
|
|
|
|
|
|
|
has $name => ( |
451
|
|
|
|
|
|
|
is => 'rw', |
452
|
|
|
|
|
|
|
isa => __PACKAGE__.'::NonNegNum', |
453
|
|
|
|
|
|
|
default => 0, |
454
|
|
|
|
|
|
|
trigger => sub { $_[0]->_modified_set( $name ) }, |
455
|
|
|
|
|
|
|
); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
#-- private attributes --------------------------------------------------------- |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
has '_meta_data' => ( |
461
|
|
|
|
|
|
|
is => 'rw', |
462
|
|
|
|
|
|
|
isa => 'HashRef', |
463
|
|
|
|
|
|
|
init_arg => 'meta_data', |
464
|
|
|
|
|
|
|
default => sub { {} }, |
465
|
|
|
|
|
|
|
); |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
has '__modified' => ( |
468
|
|
|
|
|
|
|
is => 'ro', |
469
|
|
|
|
|
|
|
isa => 'HashRef[Int]', |
470
|
|
|
|
|
|
|
lazy => 1, |
471
|
|
|
|
|
|
|
init_arg => undef, # we make it impossible to set this attribute when creating a new object |
472
|
|
|
|
|
|
|
builder => '_build_modified', |
473
|
|
|
|
|
|
|
); |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
has '__modified_meta_data' => ( |
476
|
|
|
|
|
|
|
is => 'rw', |
477
|
|
|
|
|
|
|
isa => 'HashRef[Int]', |
478
|
|
|
|
|
|
|
lazy => 1, |
479
|
|
|
|
|
|
|
init_arg => undef, # we make it impossible to set this attribute when creating a new object |
480
|
|
|
|
|
|
|
default => sub { return {}; }, |
481
|
|
|
|
|
|
|
); |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
#-- public methods ------------------------------------------------------------- |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=head3 C |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
Returns the time (a floating seconds since the epoch) since the job started processing (see L) |
488
|
|
|
|
|
|
|
till job L or L or to the current time. |
489
|
|
|
|
|
|
|
Returns C if the start processing time was set to 0. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=cut |
492
|
|
|
|
|
|
|
sub elapsed { |
493
|
6
|
|
|
6
|
1
|
5360
|
my ( $self ) = @_; |
494
|
|
|
|
|
|
|
|
495
|
6
|
100
|
|
|
|
21
|
if ( my $started = $self->started ) { |
496
|
3
|
|
66
|
|
|
27
|
return( ( $self->completed || $self->failed || Time::HiRes::time ) - $started ); |
497
|
|
|
|
|
|
|
} else { |
498
|
3
|
|
|
|
|
10
|
return( undef ); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=head3 C |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
With no arguments, returns a reference to a hash of metadata (additional information related to the job). |
505
|
|
|
|
|
|
|
For example: |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my $md = $job->meta_data; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Hash value of an individual item metadata is available by specifying the name of the hash key. |
510
|
|
|
|
|
|
|
For example: |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
my $foo = $job->meta_data( 'foo' ); |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Separate metadata value can be set as follows: |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
my $foo = $job->meta_data( next => 16 ); |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
Group metadata can be specified by reference to a hash. |
519
|
|
|
|
|
|
|
Metadata may contain scalars, references to arrays and hashes, objects. |
520
|
|
|
|
|
|
|
For example: |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
$job->meta_data( |
523
|
|
|
|
|
|
|
{ |
524
|
|
|
|
|
|
|
'foo' => 12, |
525
|
|
|
|
|
|
|
'bar' => [ 13, 14, 15 ], |
526
|
|
|
|
|
|
|
'other' => { a => 'b', c => 'd' }, |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
); |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
The name of the metadata fields should not match the standard names returned by |
531
|
|
|
|
|
|
|
L and must not begin with C<'__'}>. |
532
|
|
|
|
|
|
|
An invalid name causes die (C). |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=cut |
535
|
|
|
|
|
|
|
my %_attributes = map { ( $_->name eq '_meta_data' ? 'meta_data' : $_->name ) => 1 } grep { substr( $_->name, 0, 2 ) ne '__' } $meta->get_all_attributes; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub meta_data { |
538
|
46
|
|
|
46
|
1
|
10993
|
my ( $self, $key, $val ) = @_; |
539
|
|
|
|
|
|
|
|
540
|
46
|
100
|
|
|
|
137
|
return $self->_meta_data |
541
|
|
|
|
|
|
|
if !defined $key; |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
# metadata can be set with an external hash |
544
|
35
|
100
|
|
|
|
85
|
if ( _HASH0( $key ) ) { |
545
|
16
|
|
|
|
|
39
|
foreach my $field ( keys %$key ) { |
546
|
|
|
|
|
|
|
confess 'The name of the metadata field the same as standart job field name' |
547
|
17
|
100
|
66
|
|
|
140
|
if exists $_attributes{ $field } || substr( $field, 0, 2 ) eq '__'; |
548
|
|
|
|
|
|
|
} |
549
|
1
|
|
|
|
|
3
|
$self->_meta_data( $key ); |
550
|
1
|
|
|
|
|
3
|
$self->__modified_meta_data( {} ); |
551
|
|
|
|
|
|
|
$self->__modified_meta_data->{ $_ } = 1 |
552
|
1
|
|
|
|
|
5
|
foreach keys %$key; |
553
|
1
|
|
|
|
|
4
|
return; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# getter |
557
|
19
|
100
|
|
|
|
35
|
return $self->_meta_data->{ $key } |
558
|
|
|
|
|
|
|
if !defined $val; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# setter |
561
|
|
|
|
|
|
|
confess 'The name of the metadata field the same as standart job field name' |
562
|
17
|
100
|
66
|
|
|
149
|
if exists $_attributes{ $key } || substr( $key, 0, 2 ) eq '__'; |
563
|
2
|
|
|
|
|
5
|
$self->_meta_data->{ $key } = $val; |
564
|
2
|
|
|
|
|
9
|
++$self->__modified_meta_data->{ $key }; |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# job data change |
567
|
2
|
|
|
|
|
7
|
$self->updated( Time::HiRes::time ); |
568
|
2
|
|
|
|
|
4
|
++$self->__modified->{ 'updated' }; |
569
|
|
|
|
|
|
|
|
570
|
2
|
|
|
|
|
4
|
return; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
=head3 C |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
Resets the sign of any specified attributes that have been changed. |
576
|
|
|
|
|
|
|
If no attribute names are specified, the signs are reset for all attributes. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=cut |
579
|
|
|
|
|
|
|
sub clear_modified { |
580
|
47
|
|
|
47
|
1
|
10528
|
my ( $self, @fields ) = @_; |
581
|
|
|
|
|
|
|
|
582
|
47
|
100
|
|
|
|
89
|
unless ( @fields ) { |
583
|
15
|
|
|
|
|
22
|
$self->clear_modified( $self->job_attributes ); |
584
|
15
|
|
|
|
|
20
|
my @keys = keys %{ $self->__modified_meta_data }; |
|
15
|
|
|
|
|
29
|
|
585
|
15
|
50
|
|
|
|
25
|
$self->clear_modified( @keys ) |
586
|
|
|
|
|
|
|
if @keys; |
587
|
15
|
|
|
|
|
19
|
return; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
32
|
|
|
|
|
44
|
foreach my $field ( @fields ) { |
591
|
256
|
50
|
|
|
|
317
|
if ( exists $self->__modified->{ $field } ) { $self->__modified->{ $field } = 0 } |
|
256
|
0
|
|
|
|
304
|
|
592
|
0
|
|
|
|
|
0
|
elsif ( exists $self->__modified_meta_data->{ $field } ) { $self->__modified_meta_data->{ $field } = 0 } |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
=head3 C |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
Returns a list of names of the object attributes that have been modified. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=cut |
601
|
|
|
|
|
|
|
sub modified_attributes { |
602
|
31
|
|
|
31
|
1
|
618
|
my ( $self ) = @_; |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
my @all_modified = ( |
605
|
465
|
|
|
|
|
458
|
grep( { $self->__modified->{ $_ } } $self->job_attributes ), |
606
|
31
|
|
|
|
|
34
|
grep( { $self->__modified_meta_data->{ $_ } } keys( %{ $self->__modified_meta_data } ) ), |
|
0
|
|
|
|
|
0
|
|
|
31
|
|
|
|
|
65
|
|
607
|
|
|
|
|
|
|
); |
608
|
|
|
|
|
|
|
|
609
|
31
|
|
|
|
|
85
|
return @all_modified; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=head3 C |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
Returns a sorted list of the names of object attributes. |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
=cut |
617
|
|
|
|
|
|
|
sub job_attributes { |
618
|
130
|
|
|
130
|
1
|
3576
|
return( sort keys %_attributes ); |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
#-- private methods ------------------------------------------------------------ |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
sub _build_data { |
624
|
0
|
|
|
0
|
|
0
|
my $empty_data = q{}; |
625
|
0
|
|
|
|
|
0
|
return \$empty_data; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub _build_modified { |
629
|
14
|
|
|
14
|
|
15
|
my ( $self ) = @_; |
630
|
|
|
|
|
|
|
|
631
|
14
|
|
|
|
|
13
|
my %modified; |
632
|
14
|
|
|
|
|
29
|
map { $modified{ $_ } = 1 } $self->job_attributes; |
|
210
|
|
|
|
|
185
|
|
633
|
14
|
|
|
|
|
100
|
return \%modified; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
sub _modified_set { |
637
|
246
|
|
|
246
|
|
166
|
my $self = shift; |
638
|
246
|
|
|
|
|
162
|
my $field = shift; |
639
|
|
|
|
|
|
|
|
640
|
246
|
100
|
|
|
|
548
|
if ( $field =~ /^(status|meta_data|workload|result|progress|message|started|completed|failed)$/ ) { |
641
|
85
|
|
|
|
|
249
|
$self->updated( Time::HiRes::time ); |
642
|
85
|
|
|
|
|
107
|
++$self->__modified->{ 'updated' }; |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
246
|
100
|
|
|
|
304
|
if ( $field eq 'status' ) { |
646
|
19
|
|
|
|
|
19
|
my $new_status = shift; |
647
|
19
|
50
|
|
|
|
74
|
if ( $new_status eq STATUS_CREATED ) { $self->created( Time::HiRes::time ) } |
|
0
|
100
|
|
|
|
0
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
648
|
4
|
100
|
|
|
|
21
|
elsif ( $new_status eq STATUS_WORKING ) { $self->started( Time::HiRes::time ) unless $self->started } |
649
|
2
|
|
|
|
|
5
|
elsif ( $new_status eq STATUS_COMPLETED ) { $self->completed( Time::HiRes::time ) } |
650
|
2
|
|
|
|
|
6
|
elsif ( $new_status eq STATUS_FAILED ) { $self->failed( Time::HiRes::time ) } |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
246
|
|
|
|
|
474
|
++$self->__modified->{ $field }; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
#-- Closes and cleans up ------------------------------------------------------- |
657
|
|
|
|
|
|
|
|
658
|
68
|
|
|
68
|
|
380
|
no Mouse::Util::TypeConstraints; |
|
68
|
|
|
|
|
82
|
|
|
68
|
|
|
|
|
342
|
|
659
|
68
|
|
|
68
|
|
7697
|
no Mouse; # keywords are removed from the package |
|
68
|
|
|
|
|
71
|
|
|
68
|
|
|
|
|
213
|
|
660
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable(); |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
__END__ |