File Coverage

lib/Net/ISC/DHCPd/Config/Block.pm
Criterion Covered Total %
statement 27 27 100.0
branch 10 12 83.3
condition n/a
subroutine 8 8 100.0
pod 7 7 100.0
total 52 54 96.3


line stmt bran cond sub pod time code
1             package Net::ISC::DHCPd::Config::Block;
2              
3             =head1 NAME
4              
5             Net::ISC::DHCPd::Config::Block - Unknown config blocks
6              
7             =head1 DESCRIPTION
8              
9             See L<Net::ISC::DHCPd::Config::Role> for methods and attributes without
10             documentation.
11              
12             An instance from this class, comes from / will produce:
13              
14             $type $name {
15             $body_attribute_value
16             }
17              
18             $type "$string" {
19             $body_attribute_value
20             }
21              
22             IMPORTANT! "Blocks" may be redefined to a "real" instance later on.
23             This is simply here as a "catch-all" feature, in case something
24             could not be parsed.
25              
26             =head1 SYNOPSIS
27              
28             See L<Net::ISC::DHCPd::Config/SYNOPSIS>.
29              
30             =cut
31              
32 24     24   25067 use Moose;
  24         56  
  24         224  
33              
34             with 'Net::ISC::DHCPd::Config::Role';
35              
36             =head1 ATTRIBUTES
37              
38             =head2 type
39              
40             See L</SYNOPSIS>.
41              
42             =head2 name
43              
44             See L</SYNOPSIS>.
45              
46             =cut
47              
48             has [qw/ type name /] => (
49             is => 'ro',
50             isa => 'Str',
51             );
52              
53             =head2 quoted
54              
55             This flag tells if the name should be quoted or not.
56              
57             =cut
58              
59             has quoted => (
60             is => 'ro',
61             isa => 'Bool',
62             );
63              
64             =head2 body
65              
66             The body of the block, without trailing newline at end.
67             This text is not parsed, so the containing text can be anything.
68              
69             =cut
70              
71             has _body => (
72             is => 'rw',
73             isa => 'ArrayRef',
74             default => sub { [] },
75             );
76              
77 3     3 1 9 sub body { join "\n", @{ shift->_body } }
  3         105  
78              
79             =head2 regex
80              
81             See L<Net::ISC::DHCPd::Config::Role/regex>.
82              
83             =cut
84              
85 29     29 1 221 sub regex { qr/^\s* ([\w-]+) \s+ (\S*) \s* { /x }
86              
87             =head2 children
88              
89             Modules with slurp need this special children variable to trick the parser
90             into recursively processing them.
91              
92             =cut
93              
94 6     6 1 105 sub children { [undef] }
95              
96             has _depth => (
97             is => 'ro',
98             isa => 'Int',
99             traits => ['Counter'],
100             default => 1,
101             handles => {
102             _inc_depth => 'inc',
103             _dec_depth => 'dec',
104             },
105             );
106              
107             =head1 METHODS
108              
109             =head2 BUILD
110              
111             Will convert body (as string) in C<new()> into a list which is used
112             internally.
113              
114             =cut
115              
116             sub BUILD {
117 7     7 1 16 my($self, $args) = @_;
118 7 100       206 push @{ $self->_body }, split /\n/, $args->{'body'} if(defined $args->{'body'});
  1         31  
119             }
120              
121             =head2 slurp
122              
123             This method is used by L<Net::ISC::DHCPd::Config::Role/parse>, and will
124             slurp the content of the function, instead of trying to parse the
125             statements.
126              
127             =cut
128              
129             sub slurp {
130 18     18 1 33 my($self, $line) = @_;
131              
132 18 100       144 $self->_inc_depth if($line =~ /{/);
133 18 100       354 $self->_dec_depth if($line =~ /}/);
134              
135 18 100       514 if($self->_depth) {
136 12         25 chomp $line;
137 12         54 $line =~ s/^\s{4}//;
138 12         19 push @{ $self->_body }, $line;
  12         417  
139 12         40 return 'next';
140             }
141             else {
142 6         26 return 'last';
143             }
144             }
145              
146             =head2 captured_to_args
147              
148             See L<Net::ISC::DHCPd::Config::Role/captured_to_args>.
149              
150             =cut
151              
152             sub captured_to_args {
153 2     2 1 6 my($type, $name) = @_;
154 2 50       13 my $quoted = $name =~ s/^"(.*)"$/$1/ ? 1 : 0;
155              
156 2         11 return { type => $type, name => $name, quoted => $quoted }
157             }
158              
159             =head2 generate
160              
161             See L<Net::ISC::DHCPd::Config::Role/generate>.
162              
163             =cut
164              
165             sub generate {
166 2     2 1 4 my $self = shift;
167 2 50       56 my $format = $self->quoted ? '%s "%s" {' : '%s %s {';
168              
169             return(
170 2         54 sprintf($format, $self->type, $self->name),
171 2         53 @{ $self->_body },
172             '}',
173             );
174             }
175              
176             =head1 COPYRIGHT & LICENSE
177              
178             =head1 AUTHOR
179              
180             See L<Net::ISC::DHCPd>.
181              
182             =cut
183              
184             __PACKAGE__->meta->make_immutable;
185              
186             1;