line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Queue::DBI::Admin; |
2
|
|
|
|
|
|
|
|
3
|
21
|
|
|
21
|
|
504578
|
use warnings; |
|
21
|
|
|
|
|
33
|
|
|
21
|
|
|
|
|
622
|
|
4
|
21
|
|
|
21
|
|
74
|
use strict; |
|
21
|
|
|
|
|
23
|
|
|
21
|
|
|
|
|
443
|
|
5
|
|
|
|
|
|
|
|
6
|
21
|
|
|
21
|
|
69
|
use Carp; |
|
21
|
|
|
|
|
24
|
|
|
21
|
|
|
|
|
967
|
|
7
|
21
|
|
|
21
|
|
7916
|
use Data::Dumper; |
|
21
|
|
|
|
|
98371
|
|
|
21
|
|
|
|
|
1091
|
|
8
|
21
|
|
|
21
|
|
6808
|
use Data::Validate::Type; |
|
21
|
|
|
|
|
85594
|
|
|
21
|
|
|
|
|
935
|
|
9
|
21
|
|
|
21
|
|
9529
|
use Try::Tiny; |
|
21
|
|
|
|
|
19755
|
|
|
21
|
|
|
|
|
845
|
|
10
|
|
|
|
|
|
|
|
11
|
21
|
|
|
21
|
|
5624
|
use Queue::DBI; |
|
21
|
|
|
|
|
42
|
|
|
21
|
|
|
|
|
32114
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Queue::DBI::Admin - Manage Queue::DBI queues. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 VERSION |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Version 2.6.2 |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $VERSION = '2.6.2'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SYNOPSIS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use Queue::DBI::Admin; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Create the object which will allow managing the queues. |
33
|
|
|
|
|
|
|
my $queues_admin = Queue::DBI::Admin->new( |
34
|
|
|
|
|
|
|
database_handle => $dbh, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Check if the tables required by Queue::DBI exist. |
38
|
|
|
|
|
|
|
if ( !$queues_admin->has_tables() ) |
39
|
|
|
|
|
|
|
{ |
40
|
|
|
|
|
|
|
# Create the tables required by Queue::DBI to store the queues and data. |
41
|
|
|
|
|
|
|
$queues_admin->create_tables(); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Create a new queue. |
45
|
|
|
|
|
|
|
my $queue = $queues_admin->create_queue( $queue_name ); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Test if a queue exists. |
48
|
|
|
|
|
|
|
if ( $queues_admin->has_queue( $queue_name ) ) |
49
|
|
|
|
|
|
|
{ |
50
|
|
|
|
|
|
|
... |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Retrieve a queue. |
54
|
|
|
|
|
|
|
my $queue = $queues_admin->retrieve_queue( $queue_name ); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Delete a queue. |
57
|
|
|
|
|
|
|
$queues_admin->delete_queue( $queue_name ); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 SUPPORTED DATABASES |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
This distribution currently supports: |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=over 4 |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=item * SQLite |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=item * MySQL |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item * PostgreSQL |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=back |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Please contact me if you need support for another database type, I'm always |
75
|
|
|
|
|
|
|
glad to add extensions if you can help me with testing. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 QUEUES ADMINISTRATION METHODS |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 new() |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Create a new Queue::DBI::Admin object. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
my $queues_admin = Queue::DBI::Admin->new( |
85
|
|
|
|
|
|
|
database_handle => $database_handle, |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The 'database_handle' parameter is mandatory and must correspond to a |
89
|
|
|
|
|
|
|
DBI connection handle object. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Optional parameters: |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=over 4 |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item * queues_table_name |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
By default, Queue::DBI uses a table named I to store the queue |
98
|
|
|
|
|
|
|
definitions. This allows using your own name, if you want to support separate |
99
|
|
|
|
|
|
|
queuing systems or legacy systems. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item * queue_elements_table_name |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
By default, Queue::DBI uses a table named I to store the queued |
104
|
|
|
|
|
|
|
data. This allows using your own name, if you want to support separate queuing |
105
|
|
|
|
|
|
|
systems or legacy systems. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=back |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
my $queues_admin = Queue::DBI::Admin->new( |
110
|
|
|
|
|
|
|
database_handle => $database_handle, |
111
|
|
|
|
|
|
|
queues_table_name => $custom_queues_table_name, |
112
|
|
|
|
|
|
|
queue_elements_table_name => $custom_queue_elements_table_name, |
113
|
|
|
|
|
|
|
); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=cut |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub new |
118
|
|
|
|
|
|
|
{ |
119
|
40
|
|
|
40
|
1
|
336591
|
my ( $class, %args ) = @_; |
120
|
40
|
|
|
|
|
101
|
my $database_handle = delete( $args{'database_handle'} ); |
121
|
40
|
|
|
|
|
76
|
my $queues_table_name = delete( $args{'queues_table_name'} ); |
122
|
40
|
|
|
|
|
70
|
my $queue_elements_table_name = delete( $args{'queue_elements_table_name'} ); |
123
|
|
|
|
|
|
|
|
124
|
40
|
100
|
|
|
|
160
|
croak 'Unrecognized arguments: ' . join( ', ', keys %args ) |
125
|
|
|
|
|
|
|
if scalar( keys %args ) != 0; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Verify arguments. |
128
|
39
|
100
|
|
|
|
177
|
croak 'The argument "database_handle" must be a DBI connection handle object' |
129
|
|
|
|
|
|
|
if !Data::Validate::Type::is_instance( $database_handle, class => 'DBI::db' ); |
130
|
|
|
|
|
|
|
|
131
|
37
|
|
|
|
|
900
|
my $self = bless( |
132
|
|
|
|
|
|
|
{ |
133
|
|
|
|
|
|
|
database_handle => $database_handle, |
134
|
|
|
|
|
|
|
table_names => |
135
|
|
|
|
|
|
|
{ |
136
|
|
|
|
|
|
|
'queues' => $queues_table_name, |
137
|
|
|
|
|
|
|
'queue_elements' => $queue_elements_table_name, |
138
|
|
|
|
|
|
|
}, |
139
|
|
|
|
|
|
|
tables_verified => 0, |
140
|
|
|
|
|
|
|
}, |
141
|
|
|
|
|
|
|
$class |
142
|
|
|
|
|
|
|
); |
143
|
|
|
|
|
|
|
|
144
|
37
|
|
|
|
|
159
|
return $self; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head2 create_queue() |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Create a new queue. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
$queues_admin->create_queue( $queue_name ); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=cut |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub create_queue |
157
|
|
|
|
|
|
|
{ |
158
|
2
|
|
|
2
|
1
|
1092
|
my ( $self, $queue_name ) = @_; |
159
|
2
|
|
|
|
|
10
|
my $database_handle = $self->get_database_handle(); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Verify parameters. |
162
|
2
|
50
|
33
|
|
|
18
|
croak 'The first parameter must be a queue name' |
163
|
|
|
|
|
|
|
if !defined( $queue_name ) || ( $queue_name eq '' ); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Make sure the tables are correctly set up. |
166
|
2
|
|
|
|
|
8
|
$self->assert_tables_verified(); |
167
|
|
|
|
|
|
|
|
168
|
2
|
|
|
|
|
4
|
my $queues_table_name = $database_handle->quote_identifier( |
169
|
|
|
|
|
|
|
$self->get_queues_table_name() |
170
|
|
|
|
|
|
|
); |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Create the queue. |
173
|
2
|
50
|
|
|
|
45
|
$database_handle->do( |
174
|
|
|
|
|
|
|
sprintf( |
175
|
|
|
|
|
|
|
q| |
176
|
|
|
|
|
|
|
INSERT INTO %s ( name ) |
177
|
|
|
|
|
|
|
VALUES ( ? ) |
178
|
|
|
|
|
|
|
|, |
179
|
|
|
|
|
|
|
$queues_table_name, |
180
|
|
|
|
|
|
|
), |
181
|
|
|
|
|
|
|
{}, |
182
|
|
|
|
|
|
|
$queue_name, |
183
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
184
|
|
|
|
|
|
|
|
185
|
2
|
|
|
|
|
73002
|
return; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head2 has_queue() |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Test if a queue exists. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
if ( $queues_admin->has_queue( $queue_name ) ) |
194
|
|
|
|
|
|
|
{ |
195
|
|
|
|
|
|
|
... |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub has_queue |
201
|
|
|
|
|
|
|
{ |
202
|
4
|
|
|
4
|
1
|
1064
|
my ( $self, $queue_name ) = @_; |
203
|
4
|
|
|
|
|
10
|
my $database_handle = $self->get_database_handle(); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# Verify parameters. |
206
|
4
|
50
|
33
|
|
|
21
|
croak 'The first parameter must be a queue name' |
207
|
|
|
|
|
|
|
if !defined( $queue_name ) || ( $queue_name eq '' ); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Make sure the tables are correctly set up. |
210
|
4
|
|
|
|
|
6
|
$self->assert_tables_verified(); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
return try |
213
|
|
|
|
|
|
|
{ |
214
|
4
|
|
|
4
|
|
114
|
my $queue = $self->retrieve_queue( $queue_name ); |
215
|
|
|
|
|
|
|
|
216
|
2
|
50
|
|
|
|
4
|
croak 'The queue does not exist' |
217
|
|
|
|
|
|
|
if !defined( $queue ); |
218
|
|
|
|
|
|
|
|
219
|
2
|
|
|
|
|
13
|
return 1; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
catch |
222
|
|
|
|
|
|
|
{ |
223
|
2
|
|
|
2
|
|
386
|
return 0; |
224
|
4
|
|
|
|
|
20
|
}; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 retrieve_queue() |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Retrieve a queue. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my $queue = $queues_admin->retrieve_queue( $queue_name ); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# See Queue::DBI->new() for all the available options. |
235
|
|
|
|
|
|
|
my $queue = $queues_admin->retrieve_queue( |
236
|
|
|
|
|
|
|
$queue_name, |
237
|
|
|
|
|
|
|
'cleanup_timeout' => 3600, |
238
|
|
|
|
|
|
|
'verbose' => 1, |
239
|
|
|
|
|
|
|
'max_requeue_count' => 5, |
240
|
|
|
|
|
|
|
); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub retrieve_queue |
245
|
|
|
|
|
|
|
{ |
246
|
12
|
|
|
12
|
1
|
1343
|
my ( $self, $queue_name, %args ) = @_; |
247
|
12
|
|
|
|
|
24
|
my $database_handle = $self->get_database_handle(); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Verify parameters. |
250
|
12
|
50
|
33
|
|
|
56
|
croak 'The first parameter must be a queue name' |
251
|
|
|
|
|
|
|
if !defined( $queue_name ) || ( $queue_name eq '' ); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Make sure the tables are correctly set up. |
254
|
12
|
|
|
|
|
21
|
$self->assert_tables_verified(); |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Instantiate a Queue::DBI object. |
257
|
12
|
|
|
|
|
23
|
my $queue = Queue::DBI->new( |
258
|
|
|
|
|
|
|
database_handle => $database_handle, |
259
|
|
|
|
|
|
|
queue_name => $queue_name, |
260
|
|
|
|
|
|
|
queues_table_name => $self->get_queues_table_name(), |
261
|
|
|
|
|
|
|
queue_elements_table_name => $self->get_queue_elements_table_name(), |
262
|
|
|
|
|
|
|
%args |
263
|
|
|
|
|
|
|
); |
264
|
|
|
|
|
|
|
|
265
|
6
|
|
|
|
|
18
|
return $queue; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head2 delete_queue() |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Delete a queue and all associated data, permanently. Use this function at your |
272
|
|
|
|
|
|
|
own risk! |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
$queues_admin->delete_queue( $queue_name ); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=cut |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub delete_queue |
279
|
|
|
|
|
|
|
{ |
280
|
2
|
|
|
2
|
1
|
395
|
my ( $self, $queue_name ) = @_; |
281
|
2
|
|
|
|
|
6
|
my $database_handle = $self->get_database_handle(); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Verify parameters. |
284
|
2
|
50
|
33
|
|
|
14
|
croak 'The first parameter must be a queue name' |
285
|
|
|
|
|
|
|
if !defined( $queue_name ) || ( $queue_name eq '' ); |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Make sure the tables are correctly set up. |
288
|
2
|
|
|
|
|
3
|
$self->assert_tables_verified(); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# Retrieve the queue object, to get the queue ID. |
291
|
2
|
|
|
|
|
5
|
my $queue = $self->retrieve_queue( $queue_name ); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Delete queue elements. |
294
|
2
|
|
|
|
|
4
|
my $queue_elements_table_name = $database_handle->quote_identifier( |
295
|
|
|
|
|
|
|
$self->get_queue_elements_table_name() |
296
|
|
|
|
|
|
|
); |
297
|
|
|
|
|
|
|
|
298
|
2
|
50
|
|
|
|
40
|
$database_handle->do( |
299
|
|
|
|
|
|
|
sprintf( |
300
|
|
|
|
|
|
|
q| |
301
|
|
|
|
|
|
|
DELETE |
302
|
|
|
|
|
|
|
FROM %s |
303
|
|
|
|
|
|
|
WHERE queue_id = ? |
304
|
|
|
|
|
|
|
|, |
305
|
|
|
|
|
|
|
$queue_elements_table_name, |
306
|
|
|
|
|
|
|
), |
307
|
|
|
|
|
|
|
{}, |
308
|
|
|
|
|
|
|
$queue->get_queue_id(), |
309
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# Delete the queue. |
312
|
2
|
|
|
|
|
299
|
my $queues_table_name = $database_handle->quote_identifier( |
313
|
|
|
|
|
|
|
$self->get_queues_table_name() |
314
|
|
|
|
|
|
|
); |
315
|
|
|
|
|
|
|
|
316
|
2
|
50
|
|
|
|
39
|
$database_handle->do( |
317
|
|
|
|
|
|
|
sprintf( |
318
|
|
|
|
|
|
|
q| |
319
|
|
|
|
|
|
|
DELETE |
320
|
|
|
|
|
|
|
FROM %s |
321
|
|
|
|
|
|
|
WHERE queue_id = ? |
322
|
|
|
|
|
|
|
|, |
323
|
|
|
|
|
|
|
$queues_table_name, |
324
|
|
|
|
|
|
|
), |
325
|
|
|
|
|
|
|
{}, |
326
|
|
|
|
|
|
|
$queue->get_queue_id(), |
327
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
328
|
|
|
|
|
|
|
|
329
|
2
|
|
|
|
|
133532
|
return; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=head1 DATABASE SETUP METHODS |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=head2 has_tables() |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
Determine if the tables required for L to operate exist. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
my $tables_exist = $queues_admin->has_tables(); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
This method returns 1 if all tables exist, 0 if none exist, and croaks with |
342
|
|
|
|
|
|
|
more information if some tables are missing or if the mandatory fields on some |
343
|
|
|
|
|
|
|
of the tables are missing. |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=cut |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub has_tables |
348
|
|
|
|
|
|
|
{ |
349
|
18
|
|
|
18
|
1
|
2943
|
my ( $self ) = @_; |
350
|
18
|
|
|
|
|
49
|
my $database_handle = $self->get_database_handle(); |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Check the database type. |
353
|
18
|
|
|
|
|
51
|
$self->assert_database_type_supported(); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Check if the queues table exists. |
356
|
18
|
|
|
|
|
51
|
my $queues_table_exists = $self->has_table( 'queues' ); |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# Check if the queue elements table exists. |
359
|
18
|
|
|
|
|
40
|
my $queue_elements_table_exists = $self->has_table( 'queue_elements' ); |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# If both tables don't exist, return 0. |
362
|
18
|
100
|
66
|
|
|
68
|
return 0 |
363
|
|
|
|
|
|
|
if !$queues_table_exists && !$queue_elements_table_exists; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# If one of the tables is missing, we want the user to know that there is |
366
|
|
|
|
|
|
|
# a problem to fix and that create_table() won't work. |
367
|
14
|
100
|
100
|
|
|
69
|
croak "The table '" . $self->get_queues_table_name() . "' exists, but '" . $self->get_queue_elements_table_name() . "' is missing" |
368
|
|
|
|
|
|
|
if $queues_table_exists && !$queue_elements_table_exists; |
369
|
13
|
100
|
66
|
|
|
40
|
croak "The table '" . $self->get_queue_elements_table_name() . "' exists, but '" . $self->get_queues_table_name() . "' is missing" |
370
|
|
|
|
|
|
|
if !$queues_table_exists && $queue_elements_table_exists; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Check if the queues table has the mandatory fields. |
373
|
12
|
|
|
|
|
35
|
my $queues_table_has_fields = $self->has_mandatory_fields( 'queues' ); |
374
|
12
|
100
|
|
|
|
47
|
croak "The table '" . $self->get_queues_table_name() . "' exists, but is missing mandatory fields" |
375
|
|
|
|
|
|
|
if !$queues_table_has_fields; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# Check if the queue elements table has the mandatory fields. |
378
|
11
|
|
|
|
|
47
|
my $queue_elements_table_has_fields = $self->has_mandatory_fields( 'queue_elements' ); |
379
|
11
|
100
|
|
|
|
35
|
croak "The table '" . $self->get_queue_elements_table_name() . "' exists, but is missing mandatory fields" |
380
|
|
|
|
|
|
|
if !$queue_elements_table_has_fields; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# Both tables exist and have the mandatory fields for Queue::DBI to |
383
|
|
|
|
|
|
|
# work, we can safely return 1. |
384
|
10
|
|
|
|
|
28
|
return 1; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head2 create_tables() |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Create the tables required by L to store the queues and data. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
$queues_admin->create_tables( |
393
|
|
|
|
|
|
|
drop_if_exist => $boolean, |
394
|
|
|
|
|
|
|
); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
By default, it won't drop any table but you can force that by setting |
397
|
|
|
|
|
|
|
'drop_if_exist' to 1. See C for more information on how tables |
398
|
|
|
|
|
|
|
are dropped. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=cut |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub create_tables |
403
|
|
|
|
|
|
|
{ |
404
|
3
|
|
|
3
|
1
|
730
|
my ( $self, %args ) = @_; |
405
|
3
|
|
100
|
|
|
47
|
my $drop_if_exist = delete( $args{'drop_if_exist'} ) || 0; |
406
|
3
|
50
|
|
|
|
12
|
croak 'Unrecognized arguments: ' . join( ', ', keys %args ) |
407
|
|
|
|
|
|
|
if scalar( keys %args ) != 0; |
408
|
|
|
|
|
|
|
|
409
|
3
|
|
|
|
|
12
|
my $database_handle = $self->get_database_handle(); |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Check the database type. |
412
|
3
|
|
|
|
|
9
|
my $database_type = $self->assert_database_type_supported(); |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# Prepare the name of the tables. |
415
|
3
|
|
|
|
|
7
|
my $queues_table_name = $self->get_queues_table_name(); |
416
|
3
|
|
|
|
|
8
|
my $quoted_queues_table_name = $self->get_quoted_queues_table_name(); |
417
|
|
|
|
|
|
|
|
418
|
3
|
|
|
|
|
142
|
my $queue_elements_table_name = $self->get_queue_elements_table_name(); |
419
|
3
|
|
|
|
|
8
|
my $quoted_queue_elements_table_name = $self->get_quoted_queue_elements_table_name(); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# Drop the tables, if requested. |
422
|
3
|
100
|
|
|
|
49
|
$self->drop_tables() |
423
|
|
|
|
|
|
|
if $drop_if_exist; |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# Create the list of queues. |
426
|
3
|
50
|
|
|
|
8
|
if ( $database_type eq 'SQLite' ) |
|
|
0
|
|
|
|
|
|
427
|
|
|
|
|
|
|
{ |
428
|
3
|
50
|
|
|
|
23
|
$database_handle->do( |
429
|
|
|
|
|
|
|
sprintf( |
430
|
|
|
|
|
|
|
q| |
431
|
|
|
|
|
|
|
CREATE TABLE %s |
432
|
|
|
|
|
|
|
( |
433
|
|
|
|
|
|
|
queue_id INTEGER PRIMARY KEY AUTOINCREMENT, |
434
|
|
|
|
|
|
|
name VARCHAR(255) NOT NULL UNIQUE |
435
|
|
|
|
|
|
|
) |
436
|
|
|
|
|
|
|
|, |
437
|
|
|
|
|
|
|
$quoted_queues_table_name, |
438
|
|
|
|
|
|
|
) |
439
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
elsif ( $database_type eq 'Pg' ) |
442
|
|
|
|
|
|
|
{ |
443
|
0
|
|
|
|
|
0
|
my $unique_index_name = $database_handle->quote_identifier( |
444
|
|
|
|
|
|
|
'unq_' . $queues_table_name . '_name', |
445
|
|
|
|
|
|
|
); |
446
|
|
|
|
|
|
|
|
447
|
0
|
0
|
|
|
|
0
|
$database_handle->do( |
448
|
|
|
|
|
|
|
sprintf( |
449
|
|
|
|
|
|
|
q| |
450
|
|
|
|
|
|
|
CREATE TABLE %s |
451
|
|
|
|
|
|
|
( |
452
|
|
|
|
|
|
|
queue_id SERIAL, |
453
|
|
|
|
|
|
|
name VARCHAR(255) NOT NULL, |
454
|
|
|
|
|
|
|
PRIMARY KEY (queue_id), |
455
|
|
|
|
|
|
|
CONSTRAINT %s UNIQUE (name) |
456
|
|
|
|
|
|
|
) |
457
|
|
|
|
|
|
|
|, |
458
|
|
|
|
|
|
|
$quoted_queues_table_name, |
459
|
|
|
|
|
|
|
$unique_index_name, |
460
|
|
|
|
|
|
|
) |
461
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
else |
464
|
|
|
|
|
|
|
{ |
465
|
0
|
|
|
|
|
0
|
my $unique_index_name = $database_handle->quote_identifier( |
466
|
|
|
|
|
|
|
'unq_' . $queues_table_name . '_name', |
467
|
|
|
|
|
|
|
); |
468
|
|
|
|
|
|
|
|
469
|
0
|
0
|
|
|
|
0
|
$database_handle->do( |
470
|
|
|
|
|
|
|
sprintf( |
471
|
|
|
|
|
|
|
q| |
472
|
|
|
|
|
|
|
CREATE TABLE %s |
473
|
|
|
|
|
|
|
( |
474
|
|
|
|
|
|
|
queue_id INT(11) NOT NULL AUTO_INCREMENT, |
475
|
|
|
|
|
|
|
name VARCHAR(255) NOT NULL, |
476
|
|
|
|
|
|
|
PRIMARY KEY (queue_id), |
477
|
|
|
|
|
|
|
UNIQUE KEY %s (name) |
478
|
|
|
|
|
|
|
) |
479
|
|
|
|
|
|
|
ENGINE=InnoDB |
480
|
|
|
|
|
|
|
|, |
481
|
|
|
|
|
|
|
$quoted_queues_table_name, |
482
|
|
|
|
|
|
|
$unique_index_name, |
483
|
|
|
|
|
|
|
) |
484
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# Create the table that will hold the queue elements. |
488
|
3
|
50
|
|
|
|
144157
|
if ( $database_type eq 'SQLite' ) |
|
|
0
|
|
|
|
|
|
489
|
|
|
|
|
|
|
{ |
490
|
3
|
50
|
|
|
|
46
|
$database_handle->do( |
491
|
|
|
|
|
|
|
sprintf( |
492
|
|
|
|
|
|
|
q| |
493
|
|
|
|
|
|
|
CREATE TABLE %s |
494
|
|
|
|
|
|
|
( |
495
|
|
|
|
|
|
|
queue_element_id INTEGER PRIMARY KEY AUTOINCREMENT, |
496
|
|
|
|
|
|
|
queue_id INTEGER NOT NULL, |
497
|
|
|
|
|
|
|
data TEXT, |
498
|
|
|
|
|
|
|
lock_time INT(10) DEFAULT NULL, |
499
|
|
|
|
|
|
|
requeue_count INT(3) DEFAULT '0', |
500
|
|
|
|
|
|
|
created INT(10) NOT NULL DEFAULT '0' |
501
|
|
|
|
|
|
|
) |
502
|
|
|
|
|
|
|
|, |
503
|
|
|
|
|
|
|
$quoted_queue_elements_table_name, |
504
|
|
|
|
|
|
|
) |
505
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
elsif ( $database_type eq 'Pg' ) |
508
|
|
|
|
|
|
|
{ |
509
|
0
|
0
|
|
|
|
0
|
$database_handle->do( |
510
|
|
|
|
|
|
|
sprintf( |
511
|
|
|
|
|
|
|
q| |
512
|
|
|
|
|
|
|
CREATE TABLE %s |
513
|
|
|
|
|
|
|
( |
514
|
|
|
|
|
|
|
queue_element_id SERIAL, |
515
|
|
|
|
|
|
|
queue_id INTEGER NOT NULL REFERENCES %s (queue_id), |
516
|
|
|
|
|
|
|
data TEXT, |
517
|
|
|
|
|
|
|
lock_time INTEGER DEFAULT NULL, |
518
|
|
|
|
|
|
|
requeue_count SMALLINT DEFAULT 0, |
519
|
|
|
|
|
|
|
created INTEGER NOT NULL DEFAULT 0, |
520
|
|
|
|
|
|
|
PRIMARY KEY (queue_element_id) |
521
|
|
|
|
|
|
|
) |
522
|
|
|
|
|
|
|
|, |
523
|
|
|
|
|
|
|
$quoted_queue_elements_table_name, |
524
|
|
|
|
|
|
|
$quoted_queues_table_name, |
525
|
|
|
|
|
|
|
) |
526
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
527
|
|
|
|
|
|
|
|
528
|
0
|
|
|
|
|
0
|
my $queue_id_index_name = $database_handle->quote_identifier( |
529
|
|
|
|
|
|
|
'idx_' . $queue_elements_table_name . '_queue_id' |
530
|
|
|
|
|
|
|
); |
531
|
|
|
|
|
|
|
|
532
|
0
|
0
|
|
|
|
0
|
$database_handle->do( |
533
|
|
|
|
|
|
|
sprintf( |
534
|
|
|
|
|
|
|
q| |
535
|
|
|
|
|
|
|
CREATE INDEX %s |
536
|
|
|
|
|
|
|
ON %s (queue_id) |
537
|
|
|
|
|
|
|
|, |
538
|
|
|
|
|
|
|
$queue_id_index_name, |
539
|
|
|
|
|
|
|
$quoted_queue_elements_table_name, |
540
|
|
|
|
|
|
|
) |
541
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
else |
544
|
|
|
|
|
|
|
{ |
545
|
0
|
|
|
|
|
0
|
my $queue_id_index_name = $database_handle->quote_identifier( |
546
|
|
|
|
|
|
|
'idx_' . $queue_elements_table_name . '_queue_id' |
547
|
|
|
|
|
|
|
); |
548
|
0
|
|
|
|
|
0
|
my $queue_id_foreign_key_name = $database_handle->quote_identifier( |
549
|
|
|
|
|
|
|
'fk_' . $queue_elements_table_name . '_queue_id' |
550
|
|
|
|
|
|
|
); |
551
|
|
|
|
|
|
|
|
552
|
0
|
0
|
|
|
|
0
|
$database_handle->do( |
553
|
|
|
|
|
|
|
sprintf( |
554
|
|
|
|
|
|
|
q| |
555
|
|
|
|
|
|
|
CREATE TABLE %s |
556
|
|
|
|
|
|
|
( |
557
|
|
|
|
|
|
|
queue_element_id INT(10) UNSIGNED NOT NULL AUTO_INCREMENT, |
558
|
|
|
|
|
|
|
queue_id INT(11) NOT NULL, |
559
|
|
|
|
|
|
|
data TEXT, |
560
|
|
|
|
|
|
|
lock_time INT(10) UNSIGNED DEFAULT NULL, |
561
|
|
|
|
|
|
|
requeue_count INT(3) UNSIGNED DEFAULT '0', |
562
|
|
|
|
|
|
|
created INT(10) UNSIGNED NOT NULL DEFAULT '0', |
563
|
|
|
|
|
|
|
PRIMARY KEY (queue_element_id), |
564
|
|
|
|
|
|
|
KEY %s (queue_id), |
565
|
|
|
|
|
|
|
CONSTRAINT %s FOREIGN KEY (queue_id) REFERENCES %s (queue_id) |
566
|
|
|
|
|
|
|
) |
567
|
|
|
|
|
|
|
ENGINE=InnoDB |
568
|
|
|
|
|
|
|
|, |
569
|
|
|
|
|
|
|
$quoted_queue_elements_table_name, |
570
|
|
|
|
|
|
|
$queue_id_index_name, |
571
|
|
|
|
|
|
|
$queue_id_foreign_key_name, |
572
|
|
|
|
|
|
|
$quoted_queues_table_name, |
573
|
|
|
|
|
|
|
) |
574
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
3
|
|
|
|
|
132117
|
return; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head2 drop_tables() |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Drop the tables used to store the queues and queue data. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Warning: there is no undo for this operation. Make sure you really want to drop |
586
|
|
|
|
|
|
|
the tables before using this method. |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
$queues_admin->drop_tables(); |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Note: due to foreign key constraints, the tables are dropped in the reverse |
591
|
|
|
|
|
|
|
order in which they are created. |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=cut |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
sub drop_tables |
596
|
|
|
|
|
|
|
{ |
597
|
3
|
|
|
3
|
1
|
561
|
my ( $self ) = @_; |
598
|
3
|
|
|
|
|
10
|
my $database_handle = $self->get_database_handle(); |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# Check the database type. |
601
|
3
|
|
|
|
|
7
|
$self->assert_database_type_supported(); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# If the tables exist, make sure that they have the mandatory fields. This |
604
|
|
|
|
|
|
|
# prevents a user from deleting a random table using this function. |
605
|
3
|
100
|
|
|
|
8
|
if ( $self->has_table( 'queues' ) ) |
606
|
|
|
|
|
|
|
{ |
607
|
2
|
|
|
|
|
5
|
my $queues_table_name = $self->get_queues_table_name(); |
608
|
2
|
50
|
|
|
|
6
|
croak "The table '$queues_table_name' is missing some or all mandatory fields, so we cannot safely determine that it is used by Queue::DBI and delete it" |
609
|
|
|
|
|
|
|
if !$self->has_mandatory_fields( 'queues' ); |
610
|
|
|
|
|
|
|
} |
611
|
3
|
100
|
|
|
|
6
|
if ( $self->has_table( 'queue_elements' ) ) |
612
|
|
|
|
|
|
|
{ |
613
|
2
|
|
|
|
|
4
|
my $queue_elements_table_name = $self->get_queue_elements_table_name(); |
614
|
2
|
50
|
|
|
|
4
|
croak "The table '$queue_elements_table_name' is missing some or all mandatory fields, so we cannot safely determine that it is used by Queue::DBI and delete it" |
615
|
|
|
|
|
|
|
if !$self->has_mandatory_fields( 'queue_elements' ); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# Prepare the name of the tables. |
619
|
3
|
|
|
|
|
6
|
my $quoted_queues_table_name = $self->get_quoted_queues_table_name(); |
620
|
3
|
|
|
|
|
49
|
my $quoted_queue_elements_table_name = $self->get_quoted_queue_elements_table_name(); |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# Drop the tables. |
623
|
|
|
|
|
|
|
# Note: due to foreign key constraints, we need to drop the tables in the |
624
|
|
|
|
|
|
|
# reverse order in which they are created. |
625
|
3
|
50
|
|
|
|
53
|
$database_handle->do( |
626
|
|
|
|
|
|
|
sprintf( |
627
|
|
|
|
|
|
|
q|DROP TABLE IF EXISTS %s|, |
628
|
|
|
|
|
|
|
$quoted_queue_elements_table_name, |
629
|
|
|
|
|
|
|
) |
630
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
631
|
|
|
|
|
|
|
|
632
|
3
|
50
|
|
|
|
143609
|
$database_handle->do( |
633
|
|
|
|
|
|
|
sprintf( |
634
|
|
|
|
|
|
|
q|DROP TABLE IF EXISTS %s|, |
635
|
|
|
|
|
|
|
$quoted_queues_table_name, |
636
|
|
|
|
|
|
|
) |
637
|
|
|
|
|
|
|
) || croak 'Cannot execute SQL: ' . $database_handle->errstr(); |
638
|
|
|
|
|
|
|
|
639
|
3
|
|
|
|
|
50369
|
return; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=head2 get_database_handle() |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Return the database handle associated with the L object. |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
my $database_handle = $queue->get_database_handle(); |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=cut |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub get_database_handle |
654
|
|
|
|
|
|
|
{ |
655
|
245
|
|
|
245
|
1
|
498
|
my ( $self ) = @_; |
656
|
|
|
|
|
|
|
|
657
|
245
|
|
|
|
|
411
|
return $self->{'database_handle'}; |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=head2 get_queues_table_name() |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
Return the name of the table used to store queue definitions. |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
my $queues_table_name = $queues_admin->get_queues_table_name(); |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=cut |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
sub get_queues_table_name |
670
|
|
|
|
|
|
|
{ |
671
|
76
|
|
|
76
|
1
|
1304
|
my ( $self ) = @_; |
672
|
|
|
|
|
|
|
|
673
|
76
|
100
|
66
|
|
|
486
|
return defined( $self->{'table_names'}->{'queues'} ) && ( $self->{'table_names'}->{'queues'} ne '' ) |
674
|
|
|
|
|
|
|
? $self->{'table_names'}->{'queues'} |
675
|
|
|
|
|
|
|
: $Queue::DBI::DEFAULT_QUEUES_TABLE_NAME; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=head2 get_queue_elements_table_name() |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
Return the name of the table used to store queue elements. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
my $queue_elements_table_name = $queues_admin->get_queue_elements_table_name(); |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=cut |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub get_queue_elements_table_name |
688
|
|
|
|
|
|
|
{ |
689
|
71
|
|
|
71
|
1
|
500
|
my ( $self ) = @_; |
690
|
|
|
|
|
|
|
|
691
|
71
|
100
|
66
|
|
|
409
|
return defined( $self->{'table_names'}->{'queue_elements'} ) && ( $self->{'table_names'}->{'queue_elements'} ne '' ) |
692
|
|
|
|
|
|
|
? $self->{'table_names'}->{'queue_elements'} |
693
|
|
|
|
|
|
|
: $Queue::DBI::DEFAULT_QUEUE_ELEMENTS_TABLE_NAME; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=head2 get_quoted_queues_table_name() |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
Return the name of the table used to store queue definitions, quoted for |
700
|
|
|
|
|
|
|
inclusion in SQL statements. |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
my $quoted_queues_table_name = $queues_admin->get_quoted_queues_table_name(); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=cut |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub get_quoted_queues_table_name |
708
|
|
|
|
|
|
|
{ |
709
|
48
|
|
|
48
|
1
|
439
|
my ( $self ) = @_; |
710
|
|
|
|
|
|
|
|
711
|
48
|
|
|
|
|
88
|
my $database_handle = $self->get_database_handle(); |
712
|
48
|
|
|
|
|
102
|
my $queues_table_name = $self->get_queues_table_name(); |
713
|
|
|
|
|
|
|
|
714
|
48
|
50
|
|
|
|
354
|
return defined( $queues_table_name ) |
715
|
|
|
|
|
|
|
? $database_handle->quote_identifier( $queues_table_name ) |
716
|
|
|
|
|
|
|
: undef; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=head2 get_quoted_queue_elements_table_name() |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Return the name of the table used to store queue elements, quoted for inclusion |
723
|
|
|
|
|
|
|
in SQL statements. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
my $quoted_queue_elements_table_name = $queues_admin->get_quoted_queue_elements_table_name(); |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=cut |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
sub get_quoted_queue_elements_table_name |
730
|
|
|
|
|
|
|
{ |
731
|
47
|
|
|
47
|
1
|
451
|
my ( $self ) = @_; |
732
|
|
|
|
|
|
|
|
733
|
47
|
|
|
|
|
77
|
my $database_handle = $self->get_database_handle(); |
734
|
47
|
|
|
|
|
96
|
my $queue_elements_table_name = $self->get_queue_elements_table_name(); |
735
|
|
|
|
|
|
|
|
736
|
47
|
50
|
|
|
|
212
|
return defined( $queue_elements_table_name ) |
737
|
|
|
|
|
|
|
? $database_handle->quote_identifier( $queue_elements_table_name ) |
738
|
|
|
|
|
|
|
: undef; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head2 assert_database_type_supported() |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Assert (i.e., die on failure) whether the database type specified by the |
745
|
|
|
|
|
|
|
database handle passed to C is supported or not. |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
my $database_type = $queues_admin->assert_database_type_supported(); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Note: the type of the database handle associated with the current object is |
750
|
|
|
|
|
|
|
returned when it is supported. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=cut |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
sub assert_database_type_supported |
755
|
|
|
|
|
|
|
{ |
756
|
25
|
|
|
25
|
1
|
261
|
my ( $self ) = @_; |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
# Check the database type. |
759
|
25
|
|
|
|
|
61
|
my $database_type = $self->get_database_type(); |
760
|
25
|
50
|
|
|
|
214
|
croak "This database type ($database_type) is not supported yet, please email the maintainer of the module for help" |
761
|
|
|
|
|
|
|
if $database_type !~ m/^(?:SQLite|MySQL|Pg)$/ix; |
762
|
|
|
|
|
|
|
|
763
|
25
|
|
|
|
|
37
|
return $database_type; |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head2 get_database_type() |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Return the database type corresponding to the database handle associated |
770
|
|
|
|
|
|
|
with the L object. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
my $database_type = $queues_admin->get_database_type(); |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=cut |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
sub get_database_type |
777
|
|
|
|
|
|
|
{ |
778
|
26
|
|
|
26
|
1
|
465
|
my ( $self ) = @_; |
779
|
|
|
|
|
|
|
|
780
|
26
|
|
|
|
|
52
|
my $database_handle = $self->get_database_handle(); |
781
|
|
|
|
|
|
|
|
782
|
26
|
|
50
|
|
|
449
|
return $database_handle->{'Driver'}->{'Name'} || ''; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=head2 has_table() |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
Return if a table required by L to operate exists. |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
my $has_table = $queues_admin->has_table( $table_type ); |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Valid table types are: |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=over 4 |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=item * 'queues' |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=item * 'queue_elements' |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=back |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=cut |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
sub has_table |
805
|
|
|
|
|
|
|
{ |
806
|
51
|
|
|
51
|
1
|
2337
|
my ( $self, $table_type ) = @_; |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
# Check the table type. |
809
|
51
|
100
|
|
|
|
132
|
croak 'A table type must be specified' |
810
|
|
|
|
|
|
|
if !defined( $table_type ); |
811
|
50
|
50
|
|
|
|
209
|
croak "The table type '$table_type' is not valid" |
812
|
|
|
|
|
|
|
if $table_type !~ /\A(?:queues|queue_elements)\Z/x; |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
# Retrieve the table name. |
815
|
50
|
100
|
|
|
|
180
|
my $table_name = $table_type eq 'queues' |
816
|
|
|
|
|
|
|
? $self->get_quoted_queues_table_name() |
817
|
|
|
|
|
|
|
: $self->get_quoted_queue_elements_table_name(); |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
# Check if the table exists. |
820
|
50
|
|
|
|
|
1311
|
my $database_handle = $self->get_database_handle(); |
821
|
|
|
|
|
|
|
my $table_exists = |
822
|
|
|
|
|
|
|
try |
823
|
|
|
|
|
|
|
{ |
824
|
|
|
|
|
|
|
# Disable printing errors out since we expect the statement to fail. |
825
|
50
|
|
|
50
|
|
2595
|
local $database_handle->{'PrintError'} = 0; |
826
|
50
|
|
|
|
|
698
|
local $database_handle->{'RaiseError'} = 1; |
827
|
|
|
|
|
|
|
|
828
|
50
|
|
|
|
|
685
|
$database_handle->selectrow_array( |
829
|
|
|
|
|
|
|
sprintf( |
830
|
|
|
|
|
|
|
q| |
831
|
|
|
|
|
|
|
SELECT * |
832
|
|
|
|
|
|
|
FROM %s |
833
|
|
|
|
|
|
|
|, |
834
|
|
|
|
|
|
|
$table_name, |
835
|
|
|
|
|
|
|
) |
836
|
|
|
|
|
|
|
); |
837
|
|
|
|
|
|
|
|
838
|
35
|
|
|
|
|
6122
|
return 1; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
catch |
841
|
|
|
|
|
|
|
{ |
842
|
15
|
|
|
15
|
|
2242
|
return 0; |
843
|
50
|
|
|
|
|
307
|
}; |
844
|
|
|
|
|
|
|
|
845
|
50
|
|
|
|
|
651
|
return $table_exists; |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=head2 has_mandatory_fields() |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Return if a table required by L has the mandatory fields. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
my $has_mandatory_fields = $queues_admin->has_mandatory_fields( $table_type ); |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
Valid table types are: |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=over 4 |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=item * 'queues' |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * 'queue_elements' |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=back |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=cut |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
sub has_mandatory_fields |
868
|
|
|
|
|
|
|
{ |
869
|
29
|
|
|
29
|
1
|
41
|
my ( $self, $table_type ) = @_; |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
# Check the table type. |
872
|
29
|
50
|
|
|
|
66
|
croak 'A table type must be specified' |
873
|
|
|
|
|
|
|
if !defined( $table_type ); |
874
|
29
|
50
|
|
|
|
143
|
croak "The table type '$table_type' is not valid" |
875
|
|
|
|
|
|
|
if $table_type !~ /\A(?:queues|queue_elements)\Z/x; |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
# Retrieve the table name. |
878
|
29
|
100
|
|
|
|
89
|
my $table_name = $table_type eq 'queues' |
879
|
|
|
|
|
|
|
? $self->get_quoted_queues_table_name() |
880
|
|
|
|
|
|
|
: $self->get_quoted_queue_elements_table_name(); |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
# Retrieve the list of fields to check for. |
883
|
29
|
100
|
|
|
|
523
|
my $mandatory_fields = $table_type eq 'queues' |
884
|
|
|
|
|
|
|
? 'queue_id, name' |
885
|
|
|
|
|
|
|
: 'queue_element_id, queue_id, data, lock_time, requeue_count, created'; |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
# Check if the fields exist. |
888
|
29
|
|
|
|
|
49
|
my $database_handle = $self->get_database_handle(); |
889
|
|
|
|
|
|
|
my $has_mandatory_fields = |
890
|
|
|
|
|
|
|
try |
891
|
|
|
|
|
|
|
{ |
892
|
|
|
|
|
|
|
# Disable printing errors out since we expect the statement to fail. |
893
|
29
|
|
|
29
|
|
1281
|
local $database_handle->{'PrintError'} = 0; |
894
|
29
|
|
|
|
|
304
|
local $database_handle->{'RaiseError'} = 1; |
895
|
|
|
|
|
|
|
|
896
|
29
|
|
|
|
|
344
|
$database_handle->selectrow_array( |
897
|
|
|
|
|
|
|
sprintf( |
898
|
|
|
|
|
|
|
q| |
899
|
|
|
|
|
|
|
SELECT %s |
900
|
|
|
|
|
|
|
FROM %s |
901
|
|
|
|
|
|
|
|, |
902
|
|
|
|
|
|
|
$mandatory_fields, |
903
|
|
|
|
|
|
|
$table_name, |
904
|
|
|
|
|
|
|
) |
905
|
|
|
|
|
|
|
); |
906
|
|
|
|
|
|
|
|
907
|
25
|
|
|
|
|
2540
|
return 1; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
catch |
910
|
|
|
|
|
|
|
{ |
911
|
4
|
|
|
4
|
|
450
|
return 0; |
912
|
29
|
|
|
|
|
190
|
}; |
913
|
|
|
|
|
|
|
|
914
|
29
|
|
|
|
|
326
|
return $has_mandatory_fields; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=head2 assert_tables_verified() |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
Assert that the tables exist and are defined correctly. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
$queues_admin->assert_tables_verified(); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
Note that this will perform the check only once per L |
925
|
|
|
|
|
|
|
object, as this is an expensive check that would otherwise slow down the |
926
|
|
|
|
|
|
|
methods that use it. |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=cut |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
sub assert_tables_verified |
931
|
|
|
|
|
|
|
{ |
932
|
20
|
|
|
20
|
1
|
21
|
my ( $self ) = @_; |
933
|
|
|
|
|
|
|
|
934
|
20
|
100
|
|
|
|
41
|
return if $self->{'tables_verified'}; |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
# If some tables are incorrectly set up, has_tables() will croak here. |
937
|
|
|
|
|
|
|
# It however also returns 0 if no tables are defined, and we need to |
938
|
|
|
|
|
|
|
# turn it into a croak here. |
939
|
8
|
50
|
|
|
|
23
|
$self->has_tables() |
940
|
|
|
|
|
|
|
|| croak 'The queues and queue elements tables need to be created, see Queue::DBI::Admin->create_tables()'; |
941
|
|
|
|
|
|
|
|
942
|
8
|
|
|
|
|
14
|
$self->{'tables_verified'} = 1; |
943
|
|
|
|
|
|
|
|
944
|
8
|
|
|
|
|
10
|
return; |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=head1 BUGS |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Please report any bugs or feature requests through the web interface at |
951
|
|
|
|
|
|
|
L. |
952
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
953
|
|
|
|
|
|
|
your bug as I make changes. |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=head1 SUPPORT |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
perldoc Queue::DBI::Admin |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
You can also look for information at: |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=over 4 |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=item * GitHub's request tracker |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
L |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
L |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=item * CPAN Ratings |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
L |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=item * MetaCPAN |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
L |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=back |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=head1 AUTHOR |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
L, |
989
|
|
|
|
|
|
|
C<< >>. |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
Thanks to Sergey Bond for suggesting this administration module to extend |
995
|
|
|
|
|
|
|
and complete the features offered by L. |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
Copyright 2009-2015 Guillaume Aubert. |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
This program is free software: you can redistribute it and/or modify it under |
1003
|
|
|
|
|
|
|
the terms of the GNU General Public License version 3 as published by the Free |
1004
|
|
|
|
|
|
|
Software Foundation. |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT ANY |
1007
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
1008
|
|
|
|
|
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License along with |
1011
|
|
|
|
|
|
|
this program. If not, see http://www.gnu.org/licenses/ |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=cut |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
1; |