File Coverage

blib/lib/Net/Gnats/Command/DBLS.pm
Criterion Covered Total %
statement 21 21 100.0
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 2 3 66.6
total 34 36 94.4


line stmt bran cond sub pod time code
1             package Net::Gnats::Command::DBLS;
2 40     40   207 use parent 'Net::Gnats::Command';
  40         51  
  40         189  
3 40     40   2253 use strictures;
  40         61  
  40         175  
4             BEGIN {
5 40     40   3253 $Net::Gnats::Command::DBLS::VERSION = '0.21';
6             }
7 40     40   194 use vars qw($VERSION);
  40         57  
  40         1644  
8              
9 40     40   216 use Net::Gnats::Constants qw(CODE_TEXT_READY);
  40         72  
  40         7359  
10              
11             =head1 NAME
12              
13             Net::Gnats::Command::DBLS
14              
15             =head1 DESCRIPTION
16              
17             Lists the known set of databases.
18              
19             The gnatsd access level listdb denies access until the user has
20             authenticated with the USER command. The only other command
21             available at this access level is DBLS. This access level provides a
22             way for a site to secure its gnats databases while still providing a
23             way for client tools to obtain a list of the databases for use on
24             login screens etc.
25              
26             The list of databases follows, one per line, using the standard
27             quoting mechanism. Only the database names are sent.
28              
29             =head1 PROTOCOL
30              
31             DBLS
32              
33             =head1 RESPONSES
34              
35             The possible responses are:
36              
37             6xx (internal error) An internal error was encountered while trying
38             to obtain the list of available databases, usually due to lack of
39             permissions or other filesystem-related problems, or the list of
40             databases is empty.
41              
42             301 (CODE_TEXT_READY)
43              
44             =cut
45              
46             my $c = 'DBLS';
47              
48             sub new {
49 7     7 1 10 my ( $class ) = @_;
50 7 50       18 my %options = shift if $_;
51 7         21 my $self = bless \%options, $class;
52 7         24 return $self;
53             }
54              
55             sub as_string {
56 18     18 1 49 return $c;
57             }
58              
59             sub is_ok {
60 4     4 0 4 my ($self) = @_;
61 4 100       10 return 1 if $self->response->code == CODE_TEXT_READY;
62 1         4 return 0;
63             }
64              
65             1;