File Coverage

blib/lib/Queue/DBI/Admin.pm
Criterion Covered Total %
statement 154 164 93.9
branch 58 96 60.4
condition 18 31 58.0
subroutine 31 31 100.0
pod 18 18 100.0
total 279 340 82.0


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;