File Coverage

lib/Text/DHCPLeases.pm
Criterion Covered Total %
statement 84 85 98.8
branch 18 22 81.8
condition 6 9 66.6
subroutine 11 11 100.0
pod 0 3 0.0
total 119 130 91.5


line stmt bran cond sub pod time code
1             package Text::DHCPLeases;
2              
3 1     1   31086 use warnings;
  1         2  
  1         39  
4 1     1   6 use strict;
  1         1  
  1         31  
5 1     1   7 use Carp;
  1         6  
  1         113  
6 1     1   517 use Text::DHCPLeases::Object;
  1         3  
  1         39  
7 1     1   589 use Text::DHCPLeases::Object::Iterator;
  1         2  
  1         27  
8 1     1   5 use vars qw($VERSION);
  1         1  
  1         966  
9             $VERSION = '1.0';
10              
11             my $IPV4 = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
12              
13             # Make sure to return 1
14             1;
15              
16             =head1 NAME
17              
18             Text::DHCPLeases - Parse DHCP leases file from ISC dhcpd.
19              
20             =head1 SYNOPSIS
21              
22             use Text::DHCPLeases;
23              
24             my $leases = Text::DHCPLeases->new("/etc/dhcpd.leases");
25              
26             foreach my $obj ( $leases->get_objects ){
27             print $obj->name;
28             if ( $obj->binding_state eq 'active' ){
29             ...
30             }
31             ...
32              
33             =head1 DESCRIPTION
34              
35             This module provides an object-oriented interface to ISC DHCPD leases files.
36             The goal is to objectify all declarations, as defined by the ISC dhcpd package man pages.
37              
38             This interface is useful for analyzing, reporting, converting lease files,
39             or as a tool for other applications that need to import dhcpd lease data structures.
40              
41             =head1 CLASS METHODS
42             =cut
43              
44             ############################################################
45             =head2 new - Class Constructor
46              
47             Arguments:
48             Hash with the following keys:
49             file - Leases file path
50             Returns:
51             Text::DHCPLeases object
52             Examples:
53             Text::DHCPLeases->new(file=>"/etc/dhcpd.leases");
54             =cut
55             sub new{
56 1     1 0 16 my ($proto, %argv) = @_;
57 1 50       7 croak "Missing required parameters: file" unless defined $argv{file};
58 1   33     7 my $class = ref($proto) || $proto;
59 1         2 my $self = {};
60 1         4 bless $self, $class;
61 1         6 $self->{_objects} = $self->_parse($argv{file});
62 1         7 return $self;
63             }
64              
65              
66             =head1 INSTANCE METHODS
67             =cut
68              
69              
70             ############################################################
71             =head2 get_objects - Get objects from leases file
72              
73             Arguments:
74             Object attributes to match (optional)
75             Returns:
76             Array of Text::DHCPLeases::Lease objects,
77             or iterator depending on context.
78             Examples:
79             my $it = $leases->get_objects(ip_address=>'192.168.0.1');
80             while ( my $obj = $it->next ) ...
81             =cut
82             sub get_objects{
83 4     4 0 1928 my ($self, %argv) = @_;
84 4         5 my @list;
85 4 100       11 if ( %argv ){
86 2         5 foreach my $obj ( @{$self->{_objects}} ){
  2         6  
87 68         71 my $match = 1;
88 68         117 foreach my $key ( keys %argv ){
89 74 100 100     1682 if ( !defined $obj->$key || $obj->$key ne $argv{$key} ){
90 60         1194 $match = 0;
91 60         79 last;
92             }
93             }
94 68 100       412 push @list, $obj if $match;
95             }
96             }else{
97             # Use 'all' array to get real order from file
98 2         4 @list = @{$self->{_objects}};
  2         14  
99             }
100 4 100       48 wantarray? @list : DHCPLeases::Object::Iterator->new(\@list);
101             }
102              
103             ############################################################
104             =head2 print - Print all lease objects contents as a formatted string
105              
106             Arguments:
107             None
108             Returns:
109             Formatted String
110             Examples:
111             print $leases->print;
112             =cut
113             sub print{
114 1     1 0 2656 my ($self) = @_;
115 1         2 my $out = "";
116 1         4 foreach my $obj ( $self->get_objects ){
117 34         95 $out .= $obj->print;
118             }
119 1         39 return $out;
120             }
121              
122             ############################################################
123             #
124             # ********* PRIVATE METHODS **********
125             #
126             ############################################################
127              
128              
129             ############################################################
130             # _parse - Populate array of objects after reading file
131             #
132             # Arguments:
133             # filename
134             # Returns:
135             # Hash reference.
136             # Key: declaration header
137             # Value: reference to array with all objects
138             #
139             sub _parse {
140 1     1   3 my ($self, $file) = @_;
141 1         2 my @objects;
142 1         5 my $declist = $self->_get_decl($file);
143 1         4 foreach my $decl ( @$declist ){
144 34         62 my $header = $decl->{header};
145 34         49 my $lines = $decl->{lines};
146 34         36 my $obj;
147 34 50       125 if ( $header =~ /^(lease|host|group|subgroup|failover peer)/o ){
148 34         101 my $obj_data = Text::DHCPLeases::Object->parse($lines);
149 34         904 $obj = Text::DHCPLeases::Object->new(%$obj_data);
150 34         5654 push @objects, $obj;
151             }else{
152 0         0 croak "Text::DHCPLeases::_parse Error: Declaration header not recognized: '$header'\n";
153             }
154             }
155 1         62 return \@objects;
156             }
157              
158             ############################################################
159             # _get_decl - Parse file and return all declarations
160             #
161             # Arguments:
162             # filename
163             # Returns:
164             # Array ref of hashrefs.
165             #
166             sub _get_decl {
167 1     1   2 my ($self, $file) = @_;
168 1 50       58 open(FILE, "<$file") or croak "Can't open file $file: $!\n";
169 1         2 my @list;
170 1         3 my $lines = [];
171 1         2 my $header;
172 1         2 my $open = 0;
173 1         2 my $decl;
174 1         66 while ( ){
175 260         362 my $line = $_;
176 260 100       1539 next if ( $line =~ /^#|^$/o );
177 256 100 66     625 if ( !$open && $line =~ /^(.*) \{$/o ){
178 34         52 $decl = {};
179 34         70 $header = $1;
180 34         71 $decl->{header} = $header;
181 34         66 $open = 1;
182 34         51 $lines = [];
183 34         59 push @$lines, $line;
184 34         89 next;
185             }
186 222 50       361 if ( $open ){
187 222 100       388 if ( $line =~ /^\}$/o ){
188 34         38 $open = 0;
189 34         52 $decl->{lines} = $lines;
190 34         47 push @list, $decl;
191 34         47 $header = "";
192 34         142 push @$lines, $line;
193             }else{
194 188         605 push @$lines, $line;
195             }
196             }
197             }
198 1         13 close(FILE);
199 1         5 return \@list;
200             }
201              
202              
203             =head1 BUGS AND LIMITATIONS
204              
205             Correct parsing of leases files depends on changes made to the format of
206             said files by the authors of the ISC DHCPD package. This module was tested
207             against leases files generated by ISC DHCPD version 3.1.0. In addition, I
208             do not have access to leases file with all possible declarations and statements,
209             so parsing could be broken in some circumstances. Patches are welcome.
210              
211             No bugs have been reported.
212              
213             Please report any bugs or feature requests to
214             C, or through the web interface at
215             L.
216              
217              
218             =head1 AUTHOR
219              
220             Carlos Vicente
221              
222              
223             =head1 LICENCE AND COPYRIGHT
224              
225             Copyright (c) 2012, Carlos Vicente . All rights reserved.
226              
227             This module is free software; you can redistribute it and/or
228             modify it under the same terms as Perl itself. See L.
229              
230              
231             =head1 DISCLAIMER OF WARRANTY
232              
233             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
234             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
235             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
236             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
237             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
238             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
239             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
240             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
241             NECESSARY SERVICING, REPAIR, OR CORRECTION.
242              
243             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
244             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
245             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
246             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
247             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
248             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
249             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
250             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
251             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
252             SUCH DAMAGES.
253             =cut