File Coverage

lib/Net/ISC/DHCPd/Leases.pm
Criterion Covered Total %
statement 43 48 89.5
branch 10 14 71.4
condition n/a
subroutine 8 9 88.8
pod 3 3 100.0
total 64 74 86.4


line stmt bran cond sub pod time code
1             package Net::ISC::DHCPd::Leases;
2              
3             =head1 NAME
4              
5             Net::ISC::DHCPd::Leases - Parse ISC DHCPd leases
6              
7             =head1 SYNOPSIS
8              
9             my $leases = Net::ISC::DHCPd::Leases->new(
10             file => '/var/lib/dhcp3/dhcpd.leases',
11             );
12              
13             # parse the leases file
14             $leases->parse;
15              
16             for my $lease ($leases->leases) {
17             say "lease has ended" if($lease->ends < time);
18             }
19              
20             if(my $n = $leases->find_leases({ ends => time }) {
21             say "$n lease(s) has expired now";
22             }
23              
24             =head1 DESCRIPTION
25              
26             An object constructed from this class represents a leases file for
27             the dhcpd server. It is read-only, so changes to the leases file
28             must be done through a running server, using L<Net::ISC::DHCPd::OMAPI>.
29              
30             The object has one important attribute, which is L</leases>. This
31             attribute holds a list of L<Net::ISC::DHCPd::Leases::Lease> objects
32             constructed from all the leases found in the leases file.
33              
34             To parse the leases file, this module use L<POE::Filter::DHCPd::Lease>,
35             but this can be customized by setting C<_parser> in the constructor.
36             Even though it is possible, it is recommended to add features/
37             bugfixes to L<POE::Filter::DHCPd::Lease|https://rt.cpan.org/Public/Dist/Display.html?Name=POE-Filter-DHCPd-Lease>
38             instead.
39              
40             =cut
41              
42 2     2   2839 use Moose;
  2         358387  
  2         18  
43 2     2   11953 use Net::ISC::DHCPd::Leases::Lease;
  2         7  
  2         73  
44 2     2   1267 use POE::Filter::DHCPd::Lease 0.0701;
  2         7578  
  2         67  
45 2     2   456 use MooseX::Types::Path::Class 0.05 qw(File);
  2         55247  
  2         16  
46              
47             =head1 ATTRIBUTES
48              
49             =head2 leases
50              
51             Holds a list of all the leases found after reading the leases file.
52              
53             =cut
54              
55             has leases => (
56             is => 'ro',
57             isa => 'ArrayRef',
58             auto_deref => 1,
59             default => sub { [] },
60             );
61              
62             =head2 file
63              
64             This attribute holds a L<Path::Class::File> object to the leases file.
65             It is read-write and the default value is "/var/lib/dhcp3/dhcpd.leases".
66              
67             =cut
68              
69             has file => (
70             is => 'rw',
71             isa => File,
72             coerce => 1,
73             default => sub {
74             Path::Class::File->new('', 'var', 'lib', 'dhcp3', 'dhcpd.leases');
75             },
76             );
77              
78             has fh => (
79             is => 'rw',
80             isa => 'FileHandle',
81             required => 0,
82             );
83              
84             has _filehandle => (
85             is => 'ro',
86             lazy_build => 1,
87             );
88              
89             sub _build__filehandle {
90 1     1   2 my $self = shift;
91 1 50       20 if ($self->fh) {
92 0         0 return $self->fh;
93             }
94              
95 1         20 $self->file->openr;
96             }
97              
98             __PACKAGE__->meta->add_method(filehandle => sub {
99 0     0   0 Carp::cluck('->filehandle is replaced with private attribute _filehandle');
100 0         0 shift->_filehandle;
101             });
102              
103             has _parser => (
104             is => 'ro',
105             isa => 'Object',
106             default => sub { POE::Filter::DHCPd::Lease->new },
107             );
108              
109             =head1 METHODS
110              
111             =head2 parse
112              
113             Read lines from L</file>, and parses every lease it can find.
114             Returns the number of leases found. Will add each found lease to
115             L</leases>.
116              
117             =cut
118              
119             sub parse {
120 1     1 1 1093 my $self = shift;
121 1         29 my $fh = $self->_filehandle;
122 1         20 my $parser = $self->_parser;
123              
124 1 50       28 read $fh, my $buffer, -s $fh or die "Couldn't read file: $!";
125 1         5 $parser->get_one_start([$buffer]);
126 1         18 while(1) {
127 11         14463 my $leases = $parser->get_one;
128 11 100       3630 last unless (@$leases);
129 10         34 $self->add_lease($leases->[0]);
130             }
131 1         24 return ($buffer =~ tr/\n// + $buffer !~ /\n\z/);
132             }
133              
134             =head2 find_leases
135              
136             This method will return zero or more L<Net::ISC::DHCPd::Leases::Lease>
137             objects as a list. It takes a hash-ref which will be matched against
138             the attributes of the child leases.
139              
140             =cut
141              
142             sub find_leases {
143 1     1 1 3243 my $self = shift;
144 1 50       5 my $query = shift or return;
145 1         1 my @leases;
146              
147             LEASE:
148 1         28 for my $lease ($self->leases) {
149 10         42 for my $key (keys %$query) {
150 10 100       18 next LEASE unless($lease->$key eq $query->{$key});
151             }
152 1         5 push @leases, $lease;
153             }
154              
155 1         7 return @leases;
156             }
157              
158             =head2 add_lease
159              
160             This method does not make much sense, and will probably get removed.
161             See L</DESCRIPTION> for more details.
162              
163             =cut
164              
165             sub add_lease {
166 10     10 1 11 my $self = shift;
167              
168 10 50       24 if(ref $_[0] eq 'Net::ISC::DHCPd::Leases::Lease') {
169 0         0 return push @{$self->leases}, $_[0];
  0         0  
170             }
171              
172 10         10 my %lease = %{ $_[0] }; # shallow copy
  10         47  
173 10         31 my %map = (
174             ip => 'ip_address',
175             binding => 'state',
176             hostname => 'client_hostname',
177             hw_ethernet => 'hardware_address',
178             );
179              
180 10         17 for my $key (keys %map) {
181 40 100       60 if(defined $lease{$key}) {
182 30         58 $lease{ $map{$key} } = delete $lease{$key};
183             }
184             }
185              
186 10         10 return push @{$self->leases}, Net::ISC::DHCPd::Leases::Lease->new(\%lease);
  10         262  
187             }
188              
189             =head1 COPYRIGHT & LICENSE
190              
191             =head1 AUTHOR
192              
193             See L<Net::ISC::DHCPd>.
194              
195             =cut
196              
197             1;