File Coverage

lib/Net/ISC/DHCPd.pm
Criterion Covered Total %
statement 49 63 77.7
branch 12 18 66.6
condition 3 5 60.0
subroutine 9 13 69.2
pod 1 1 100.0
total 74 100 74.0


line stmt bran cond sub pod time code
1             package Net::ISC::DHCPd;
2              
3             =head1 NAME
4              
5             Net::ISC::DHCPd - Interacts with ISC DHCPd
6              
7             =head1 VERSION
8              
9             0.1704
10              
11             =head1 SYNOPSIS
12              
13             my $dhcpd = Net::ISC::DHCPd->new(
14             config => { file => "path/to/config" },
15             leases => { file => "path/to/leases" },
16             omapi => { key => "some key" },
17             );
18              
19             $self->test('config') or die $self->errstr;
20              
21             See the tests bundled to this distribution for more examples.
22              
23             =head1 DESCRIPTION
24              
25             This namespace contains three semi-separate projects, which this module
26             binds together: L<dhcpd.conf|Net::ISC::DHCPd::Config>,
27             L<dhcpd.leases|Net::ISC::DHCPd::Leases> and L<omapi|Net::ISC::DHCPd::OMAPI>.
28             It is written with L<Moose> which provides classes and roles to represents
29             things like a host, a lease or any other thing.
30              
31             The distribution as a whole is targeted an audience who configure and/or
32             analyze the L<Internet Systems Consortium DHCP Server|http://www.isc.org/software/dhcp>.
33             If you are not familiar with the server, check out
34             L<the man pages|http://www.google.com/search?q=man+dhcpd>.
35              
36             =cut
37              
38 5     5   132929 use Class::Load;
  5         168404  
  5         198  
39 5     5   5215 use Moose;
  5         2226852  
  5         43  
40 5     5   34710 use Moose::Util::TypeConstraints;
  5         11  
  5         43  
41 5     5   14070 use MooseX::Types::Path::Class qw(File);
  5         667225  
  5         48  
42 5     5   9412 use Net::ISC::DHCPd::Types ':all';
  5         19  
  5         43  
43 5     5   27796 use File::Temp;
  5         9  
  5         444  
44 5     5   69 use v5.12.5;
  5         15  
  5         3082  
45              
46             our $VERSION = eval '0.1704';
47              
48             =head1 ATTRIBUTES
49              
50             =head2 config
51              
52             This attribute holds a read-only L<Net::ISC::DHCPd::Config> object.
53             It can be set from the constructor, using either an object or a hash-ref.
54             The hash-ref will then be passed on to the constructor.
55              
56             =cut
57              
58             has config => (
59             is => 'ro',
60             isa => ConfigObject,
61             coerce => 1,
62             lazy_build => 1,
63             );
64              
65 0     0   0 __PACKAGE__->meta->add_method(_build_config => sub { _build_child_obj(Config => @_) });
66              
67             =head2 leases
68              
69             This attribute holds a read-only L<Net::ISC::DHCPd::Leases> object.
70             It can be set from the constructor, using either an object or a hash-ref.
71             The hash-ref will then be passed on to the constructor.
72              
73             =cut
74              
75             has leases => (
76             is => 'ro',
77             isa => LeasesObject,
78             coerce => 1,
79             lazy_build => 1,
80             );
81              
82 0     0   0 __PACKAGE__->meta->add_method(_build_leases => sub { _build_child_obj(Leases => @_) });
83              
84             =head2 omapi
85              
86             This attribute holds a read-only L<Net::ISC::DHCPd::OMAPI> object.
87             It can be set from the constructor, using either an object or a hash-ref.
88             The hash-ref will then be passed on to the constructor.
89              
90             =cut
91              
92             has omapi => (
93             is => 'ro',
94             isa => OMAPIObject,
95             coerce => 1,
96             lazy_build => 1,
97             );
98              
99 0     0   0 __PACKAGE__->meta->add_method(_build_omapi => sub { _build_child_obj(OMAPI => @_) });
100              
101             =head2 binary
102              
103             This attribute holds a L<Path::Class::File> object to the dhcpd binary.
104             It is read-only and the default is "dhcpd3".
105              
106             =cut
107              
108             has binary => (
109             is => 'ro',
110             isa => File,
111             coerce => 1,
112             default => 'dhcpd3',
113             );
114              
115             =head2 errstr
116              
117             Holds the last know error as a plain string.
118              
119             =cut
120              
121             has errstr => (
122             is => 'rw',
123             isa => 'Str',
124             default => '',
125             );
126              
127             =head1 METHODS
128              
129             =head2 test
130              
131             $bool = $self->test("config");
132             $bool = $self->test("leases");
133              
134             Will test either the config or leases file. It returns a boolean value
135             which indicates if it is valid or not: True means it is valid, while
136             false means it is invalid. Check L</errstr> on failure - it will contain
137             a descriptive string from either this module, C<$!> or the exit value
138             (integer stored as a string).
139              
140             =cut
141              
142             sub test {
143 9     9 1 25 my $self = shift;
144 9   50     67 my $what = shift || q();
145 9         22 my($child_error, $errno, $output);
146              
147 9 100       68 if($what eq 'config') {
    50          
148 4         44 my $tmp = File::Temp->new;
149 4         2416 print $tmp $self->config->generate;
150 4         36 $output = $self->_run('-t', '-cf', $tmp->filename);
151 3         210 ($child_error, $errno) = ($?, $!);
152             }
153             elsif($what eq 'leases') {
154 5         189 $output = $self->_run('-t', '-lf', $self->leases->file);
155 3         120 ($child_error, $errno) = ($?, $!);
156             }
157             else {
158 0         0 $self->errstr('Invalid argument');
159 0         0 return;
160             }
161              
162             # let's set this anyway...
163 6         2531 $self->errstr($output);
164              
165 6 50 66     93 if($child_error and $child_error == -1) {
    100          
166 0         0 $self->errstr($errno);
167 0         0 ($!, $?) = ($errno, $child_error);
168 0         0 return;
169             }
170             elsif($child_error) {
171 1         19 ($!, $?) = ($errno, $child_error);
172 1         32 return;
173             }
174              
175 5         161 return 1;
176             }
177              
178             sub _run {
179 9     9   53 my $self = shift;
180 9         40 my @args = @_;
181              
182 9 50       356 pipe my $reader, my $writer or return '';
183              
184 9 100       29283 if(my $pid = fork) { # parent
    50          
185 6         434 close $writer;
186 6         52444998 wait; # for child process...
187 6         239 local $/;
188 6         712 return readline $reader;
189             }
190             elsif(defined $pid) { # child
191 3         327 close $reader;
192 3 50       980 open STDERR, '>&', $writer or confess $!;
193 3 50       185 open STDOUT, '>&', $writer or confess $!;
194 3         69 { exec $self->binary, @args }
  3         1875  
195 0           confess "Exec() failed";
196             }
197              
198 0           return ''; # fork failed. check $!
199             }
200              
201             # used from attributes
202             sub _build_child_obj {
203 0     0     my $type = shift;
204 0           my $self = shift;
205              
206 0           Class::Load::load_class("Net::ISC::DHCPd::$type");
207              
208 0           return "Net::ISC::DHCPd::$type"->new(@_);
209             }
210              
211             =head1 BUGS
212              
213             Please report any bugs or feature requests to
214             C<bug-net-isc-dhcpd at rt.cpan.org>, or through the web interface at
215             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-ISC-DHCPd>.
216             I will be notified, and then you'll automatically be notified of progress on
217             your bug as I make changes.
218              
219             =head1 COPYRIGHT & LICENSE
220              
221             Copyright 2007 Jan Henning Thorsen, all rights reserved.
222              
223             This program is free software; you can redistribute it and/or modify it
224             under the same terms as Perl itself.
225              
226             =head1 AUTHOR
227              
228             Jan Henning Thorsen, C<< <jhthorsen at cpan.org> >>
229              
230             =head1 CONTRIBUTORS
231              
232             Nito Martinez
233              
234             Alexey Illarionov
235              
236             Patrick
237              
238             napetrov
239              
240             =cut
241             __PACKAGE__->meta->make_immutable;
242             1;