Text-DHCPLeases-1.0/000755 000765 000024 00000000000 12060407220 015103 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/Build.PL000444 000765 000024 00000001017 12060407220 016374 0ustar00cvicentestaff000000 000000 use Module::Build; my $build = Module::Build->new ( module_name => 'Text::DHCPLeases', license => 'perl', requires => { 'perl' => '5.8.0', 'Class::Struct' => '0.63', 'Test::More' => '0', }, ); $build->create_build_script; =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut Text-DHCPLeases-1.0/Changes000444 000765 000024 00000003032 12060407220 016372 0ustar00cvicentestaff000000 000000 Revision history for 1.0 2012/12/07 - Match 'never' in addition to $DATE in more places (Ski Kacoroski) - Fix to regex for next binding state (Simon Elsbrock) - Use /o for slightly faster regex processing 0.9 2009/08/10 - Added License text in all files - Removed requirement for version.pm 0.8 2008/12/07 - Added support for ddns-rev-name, ddns-txt and ddns-fwd-name statements, based on patch by Franck Joncourt. 0.7 2008/11/06 - Changed regex to deal with 'ends never' statement - Warn instead of die when statement not recognized 0.6 2008/07/03 - Deal with incomplete hardware address line 0.5 2008/06/05 - Fixed inconsistent licensing 0.4 2008/03/26 - Fixed bug in Iterator.pm which caused it to miss first object in list. 0.3 2008/03/13 - Fixed regular expression in Text::DHCPLeases::Object::parse that failed when hardware-type value included non-word characters (i.e "token-ring"). - Added version.pm to list of requisites in Build.PL 0.2 2007/12/20 **** API CHANGED **** - Renamed Leases.pm to Object.pm. This reflects changes in the code that allows it to deal with all possible kinds of declarations in the leases file (was missing objects created by OMAPI). - Fixed bugs in parsing reported by John Lloyd. 0.1 2007/08/21 Initial release. Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Text-DHCPLeases-1.0/lib/000755 000765 000024 00000000000 12060407220 015651 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/Makefile.PL000444 000765 000024 00000000564 12060407220 017060 0ustar00cvicentestaff000000 000000 use Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut Text-DHCPLeases-1.0/MANIFEST000444 000765 000024 00000000327 12060407220 016234 0ustar00cvicentestaff000000 000000 Build.PL Changes lib/Text/DHCPLeases.pm lib/Text/DHCPLeases/Object.pm lib/Text/DHCPLeases/Object/Iterator.pm Makefile.PL MANIFEST This list of files META.yml README t/dhcpd.leases.sample t/DHCPLeases.t t/Object.t Text-DHCPLeases-1.0/META.yml000444 000765 000024 00000001227 12060407220 016354 0ustar00cvicentestaff000000 000000 --- name: Text-DHCPLeases version: 1.0 author: - 'Carlos Vicente ' abstract: Parse DHCP leases file from ISC dhcpd. license: perl requires: Class::Struct: 0.63 Test::More: 0 perl: 5.8.0 generated_by: Module::Build version 0.280801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 provides: DHCPLeases::Object::Iterator: file: lib/Text/DHCPLeases/Object/Iterator.pm version: 1.0 Text::DHCPLeases: file: lib/Text/DHCPLeases.pm version: 1.0 Text::DHCPLeases::Object: file: lib/Text/DHCPLeases/Object.pm version: 1.0 resources: license: http://dev.perl.org/licenses/ Text-DHCPLeases-1.0/README000444 000765 000024 00000001143 12060407220 015760 0ustar00cvicentestaff000000 000000 Text::DHCPLeases Perl Module INSTALLATION You have two options: perl Build.PL ./Build ./Build test ./Build install or (if you have GNU make): perl Makefile.PL make make test make install DOCUMENTATION Documentation in POD format included with code. Try the following: perldoc lib/Text/DHCPLeases.pm perldoc lib/Text/DHCPLeases/Object.pm perldoc lib/Text/DHCPLeases/Object/Iterator.pm COPYRIGHT AND LICENCE Copyright (c) 2012, Carlos Vicente . All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Text-DHCPLeases-1.0/t/000755 000765 000024 00000000000 12060407220 015346 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/t/dhcpd.leases.sample000444 000765 000024 00000014733 12060407220 021114 0ustar00cvicentestaff000000 000000 lease 192.168.10.87 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.88 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.89 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.90 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.91 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.92 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.93 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.94 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.53 { starts 2 2007/08/14 20:51:50; ends 4 2007/09/13 20:51:50; tstp 4 2007/09/13 20:51:50; cltt 2 2007/08/14 20:51:50; binding state active; next binding state expired; hardware ethernet 08:00:09:7c:c5:9a; } lease 192.168.10.55 { starts 2 2007/08/14 21:09:19; ends 2 2007/08/14 21:19:19; tstp 2 2007/08/14 21:24:19; tsfp 2 2007/08/14 21:24:19; cltt 2 2007/08/14 21:09:19; binding state expired; next binding state free; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; client-hostname "jdoe"; } lease 192.168.10.56 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.57 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.58 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.59 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.60 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.61 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.62 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.54 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.26 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.27 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.28 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.29 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } lease 192.168.10.30 { starts 2 2007/08/14 20:51:22; tstp 2 2007/08/14 20:51:22; tsfp 2 2007/08/14 20:51:22; atsfp 2 2007/08/14 20:51:22; binding state backup; } failover peer "dhcp-peer" state { my state normal at 2 2007/08/14 20:51:22; partner state normal at 2 2007/08/14 20:51:19; } failover peer "dhcp-peer" state { my state normal at 2 2007/08/14 20:51:22; partner state communications-interrupted at 2 2007/08/14 20:51:19; } failover peer "dhcp-peer" state { my state normal at 2 2007/08/14 20:51:22; partner state communications-interrupted at 2 2007/08/14 20:51:19; } lease 192.168.10.55 { starts 3 2007/08/15 11:34:58; ends 3 2007/08/15 11:44:58; tstp 2 2007/08/14 21:24:19; tsfp 3 2007/08/15 11:49:58; cltt 3 2007/08/15 11:34:58; binding state expired; next binding state free; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; client-hostname "jdoe"; } lease 192.168.10.55 { starts 3 2007/08/15 11:34:58; ends 3 2007/08/15 11:44:58; tstp 2 2007/08/14 21:24:19; tsfp 3 2007/08/15 11:49:58; cltt 3 2007/08/15 11:34:58; binding state expired; next binding state free; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; client-hostname "jdoe"; } failover peer "dhcp-peer" state { my state normal at 2 2007/08/14 20:51:22; partner state normal at 2 2007/08/14 20:51:19; } lease 192.168.10.53 { starts 2 2007/08/14 20:51:50; ends 4 2007/09/13 20:51:50; tstp 4 2007/09/13 20:51:50; tsfp 4 2007/09/13 20:51:50; atsfp 4 2007/09/13 20:51:50; cltt 2 2007/08/14 20:51:50; binding state active; next binding state expired; hardware ethernet 08:00:09:7c:c5:9a; } lease 192.168.10.55 { starts 3 2007/08/15 11:34:58; ends 3 2007/08/15 11:44:58; tstp 3 2007/08/15 11:44:58; tsfp 2 2007/08/14 21:24:19; atsfp 2 2007/08/14 21:24:19; cltt 3 2007/08/15 11:34:58; binding state free; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; } lease 192.168.10.55 { starts 3 2007/08/15 20:31:07; ends 3 2007/08/15 11:44:58; tstp 3 2007/08/15 20:31:07; tsfp 2 2007/08/14 21:24:19; cltt 3 2007/08/15 11:34:58; binding state backup; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; } host some-host { dynamic; hardware ethernet 00:80:c7:84:b1:94; fixed-address 192.168.4.40; } lease 192.168.10.55 { starts 3 2007/08/15 20:31:07; ends 3 2007/08/15 11:44:58; tstp 3 2007/08/15 20:31:07; tsfp 3 2007/08/15 20:31:07; atsfp 3 2007/08/15 20:31:07; cltt 3 2007/08/15 11:34:58; binding state backup; hardware ethernet 00:11:85:5d:4e:68; uid "\001\000\021\205]Nh"; } Text-DHCPLeases-1.0/t/DHCPLeases.t000444 000765 000024 00000001767 12060407220 017417 0ustar00cvicentestaff000000 000000 use strict; use Test::More qw(no_plan); use lib "lib"; BEGIN { use_ok('Text::DHCPLeases'); } my $file = 't/dhcpd.leases.sample'; my $dl = Text::DHCPLeases->new(file=>$file); isa_ok($dl, 'Text::DHCPLeases', 'Constructor'); my $it = $dl->get_objects(); is($it->count, 34, 'count'); is($it->first->ip_address, '192.168.10.87', 'get_leases2'); is($it->last->ip_address, '192.168.10.55', 'get_leases3'); $it = $dl->get_objects(type=>'lease', ip_address=>'192.168.10.55'); is($it->last->tsfp, '3 2007/08/15 20:31:07', 'get_leases1'); my @objs = $dl->get_objects('mac_address'=>'08:00:09:7c:c5:9a'); is(scalar @objs, 2, 'search'); open(FILE, $file) or die "Can't open file $file: $!\n"; my $text; while(){ $text .= $_; } is($dl->print, $text, 'print'); =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut Text-DHCPLeases-1.0/t/Object.t000444 000765 000024 00000005124 12060407220 016741 0ustar00cvicentestaff000000 000000 use strict; use Test::More qw(no_plan); use lib "lib"; BEGIN { use_ok('Text::DHCPLeases::Object'); } my $text = 'lease 192.168.254.55 { starts 3 2007/08/15 11:34:58; ends 3 2007/08/15 11:44:58; tstp 3 2007/08/15 11:49:58; tsfp 2 2007/08/14 21:24:19; cltt 3 2007/08/15 11:34:58; binding state active; next binding state expired; hardware ethernet 00:11:85:5d:4e:11; uid "\001\000\021\205]Nh"; set ddns-rev-name = "55.254.168.192.in-addr.arpa."; set ddns-txt = "3111337d6d6fd4fdd8ec0776f43350fc2b"; set ddns-fwd-name = "blah.local.domain"; client-hostname "blah"; } '; my @lines = split /\n/, $text; my $lease_data = Text::DHCPLeases::Object->parse(\@lines); my $lease = Text::DHCPLeases::Object->new(%$lease_data); isa_ok($lease, 'Text::DHCPLeases::Object', 'new'); is($lease->ip_address, '192.168.254.55', 'address'); is($lease->starts, '3 2007/08/15 11:34:58' , 'start'); is($lease->ends, '3 2007/08/15 11:44:58' , 'ends'); is($lease->tstp, '3 2007/08/15 11:49:58' , 'tstp'); is($lease->tsfp, '2 2007/08/14 21:24:19' , 'tsfp'); is($lease->cltt, '3 2007/08/15 11:34:58' , 'cltt'); is($lease->binding_state, 'active' , 'binding_state'); is($lease->next_binding_state, 'expired' , 'next_binding_state'); is($lease->hardware_type, 'ethernet' , 'hardware-type'); is($lease->mac_address, '00:11:85:5d:4e:11' , 'mac-address'); is($lease->uid, '"\001\000\021\205]Nh"' , 'uid'); is($lease->ddns_rev_name, "55.254.168.192.in-addr.arpa.", 'ddns_rev_name'); is($lease->ddns_txt, "3111337d6d6fd4fdd8ec0776f43350fc2b", 'ddns_txt'); is($lease->ddns_fwd_name, "blah.local.domain", 'ddns_fwd_name'); is($lease->client_hostname, 'blah' , 'uid'); my $output = $lease->print; is($output, $text, 'print'); my $ftext = ' failover peer "dhcp-peer" state { my state communications-interrupted at 2 2007/08/14 21:10:00; partner state normal at 2 2007/08/14 20:51:22; mclt 3600; } '; my @flines = split /\n/, $ftext; my $fdata = Text::DHCPLeases::Object->parse(\@flines); my $fps = Text::DHCPLeases::Object->new(%$fdata); is($fps->name, '"dhcp-peer"', 'name'); is($fps->my_state, 'communications-interrupted', 'my_state'); is($fps->my_state_date, '2 2007/08/14 21:10:00', 'my_state_date'); is($fps->partner_state, 'normal', 'partner_state'); is($fps->partner_state_date, '2 2007/08/14 20:51:22', 'partner_state_date'); my $foutput = $fps->print; is($foutput, $ftext, 'print'); =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut Text-DHCPLeases-1.0/lib/Text/000755 000765 000024 00000000000 12060407220 016575 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/lib/Text/DHCPLeases/000755 000765 000024 00000000000 12060407220 020450 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/lib/Text/DHCPLeases.pm000444 000765 000024 00000015150 12060407220 021006 0ustar00cvicentestaff000000 000000 package Text::DHCPLeases; use warnings; use strict; use Carp; use Text::DHCPLeases::Object; use Text::DHCPLeases::Object::Iterator; use vars qw($VERSION); $VERSION = '1.0'; my $IPV4 = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}'; # Make sure to return 1 1; =head1 NAME Text::DHCPLeases - Parse DHCP leases file from ISC dhcpd. =head1 SYNOPSIS use Text::DHCPLeases; my $leases = Text::DHCPLeases->new("/etc/dhcpd.leases"); foreach my $obj ( $leases->get_objects ){ print $obj->name; if ( $obj->binding_state eq 'active' ){ ... } ... =head1 DESCRIPTION This module provides an object-oriented interface to ISC DHCPD leases files. The goal is to objectify all declarations, as defined by the ISC dhcpd package man pages. This interface is useful for analyzing, reporting, converting lease files, or as a tool for other applications that need to import dhcpd lease data structures. =head1 CLASS METHODS =cut ############################################################ =head2 new - Class Constructor Arguments: Hash with the following keys: file - Leases file path Returns: Text::DHCPLeases object Examples: Text::DHCPLeases->new(file=>"/etc/dhcpd.leases"); =cut sub new{ my ($proto, %argv) = @_; croak "Missing required parameters: file" unless defined $argv{file}; my $class = ref($proto) || $proto; my $self = {}; bless $self, $class; $self->{_objects} = $self->_parse($argv{file}); return $self; } =head1 INSTANCE METHODS =cut ############################################################ =head2 get_objects - Get objects from leases file Arguments: Object attributes to match (optional) Returns: Array of Text::DHCPLeases::Lease objects, or iterator depending on context. Examples: my $it = $leases->get_objects(ip_address=>'192.168.0.1'); while ( my $obj = $it->next ) ... =cut sub get_objects{ my ($self, %argv) = @_; my @list; if ( %argv ){ foreach my $obj ( @{$self->{_objects}} ){ my $match = 1; foreach my $key ( keys %argv ){ if ( !defined $obj->$key || $obj->$key ne $argv{$key} ){ $match = 0; last; } } push @list, $obj if $match; } }else{ # Use 'all' array to get real order from file @list = @{$self->{_objects}}; } wantarray? @list : DHCPLeases::Object::Iterator->new(\@list); } ############################################################ =head2 print - Print all lease objects contents as a formatted string Arguments: None Returns: Formatted String Examples: print $leases->print; =cut sub print{ my ($self) = @_; my $out = ""; foreach my $obj ( $self->get_objects ){ $out .= $obj->print; } return $out; } ############################################################ # # ********* PRIVATE METHODS ********** # ############################################################ ############################################################ # _parse - Populate array of objects after reading file # # Arguments: # filename # Returns: # Hash reference. # Key: declaration header # Value: reference to array with all objects # sub _parse { my ($self, $file) = @_; my @objects; my $declist = $self->_get_decl($file); foreach my $decl ( @$declist ){ my $header = $decl->{header}; my $lines = $decl->{lines}; my $obj; if ( $header =~ /^(lease|host|group|subgroup|failover peer)/o ){ my $obj_data = Text::DHCPLeases::Object->parse($lines); $obj = Text::DHCPLeases::Object->new(%$obj_data); push @objects, $obj; }else{ croak "Text::DHCPLeases::_parse Error: Declaration header not recognized: '$header'\n"; } } return \@objects; } ############################################################ # _get_decl - Parse file and return all declarations # # Arguments: # filename # Returns: # Array ref of hashrefs. # sub _get_decl { my ($self, $file) = @_; open(FILE, "<$file") or croak "Can't open file $file: $!\n"; my @list; my $lines = []; my $header; my $open = 0; my $decl; while ( ){ my $line = $_; next if ( $line =~ /^#|^$/o ); if ( !$open && $line =~ /^(.*) \{$/o ){ $decl = {}; $header = $1; $decl->{header} = $header; $open = 1; $lines = []; push @$lines, $line; next; } if ( $open ){ if ( $line =~ /^\}$/o ){ $open = 0; $decl->{lines} = $lines; push @list, $decl; $header = ""; push @$lines, $line; }else{ push @$lines, $line; } } } close(FILE); return \@list; } =head1 BUGS AND LIMITATIONS Correct parsing of leases files depends on changes made to the format of said files by the authors of the ISC DHCPD package. This module was tested against leases files generated by ISC DHCPD version 3.1.0. In addition, I do not have access to leases file with all possible declarations and statements, so parsing could be broken in some circumstances. Patches are welcome. No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Carlos Vicente =head1 LICENCE AND COPYRIGHT Copyright (c) 2012, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Text-DHCPLeases-1.0/lib/Text/DHCPLeases/Object/000755 000765 000024 00000000000 12060407220 021656 5ustar00cvicentestaff000000 000000 Text-DHCPLeases-1.0/lib/Text/DHCPLeases/Object.pm000444 000765 000024 00000026164 12060407220 022223 0ustar00cvicentestaff000000 000000 package Text::DHCPLeases::Object; use warnings; use strict; use Carp; use Class::Struct; use vars qw($VERSION); $VERSION = '1.0'; # IPv4 regular expression my $IPV4 = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}'; # weekday year/month/day hour:minute:second my $DATE = '\d+ \d{4}\/\d{2}\/\d{2} \d{2}:\d{2}:\d{2}'; =head1 NAME Text::DHCPLeases::Object - Leases Object Class =head1 SYNOPSIS my $obj = Text::DHCPLeases::Object->parse($string); or my $obj = Text::DHCPLeases::Object->new(%lease_data); print $obj->name; print $obj->type; print $obj->binding_state; =head1 DESCRIPTION DHCPLeases object class. Lease objects can be one of the following types: lease host group subgroup failover-state =cut struct ( 'type' => '$', 'name' => '$', 'ip_address' => '$', 'fixed_address' => '$', 'starts' => '$', 'ends' => '$', 'tstp' => '$', 'tsfp' => '$', 'atsfp' => '$', 'cltt' => '$', 'next_binding_state' => '$', 'binding_state' => '$', 'uid' => '$', 'client_hostname' => '$', 'abandoned' => '$', 'deleted' => '$', 'dynamic_bootp' => '$', 'dynamic' => '$', 'option_agent_circuit_id' => '$', 'option_agent_remote_id' => '$', 'hardware_type' => '$', 'mac_address' => '$', 'set' => '%', 'on' => '%', 'bootp' => '$', 'reserved' => '$', 'my_state' => '$', 'my_state_date' => '$', 'partner_state' => '$', 'partner_state_date' => '$', 'mclt' => '$', 'ddns_rev_name' => '$', 'ddns_fwd_name' => '$', 'ddns_txt' => '$' ); =head1 CLASS METHODS =head2 new - Constructor Arguments: type one of (lease|host|group|subgroup|failover-state) name identification string (address, host name, group name, etc) ip_address fixed_address starts ends tstp tsfp atsfp cltt next_binding_state binding_state uid client_hostname abandoned (flag) deleted (flag) dynamic_bootp (flag) dynamic (flag) option_agent_circuit_id option_agent_remote_id hardware_type mac_address set (hash) on (hash) bootp (flag) reserved (flag) my_state my_state_date partner_state partner_state_date mclt dns_rev_name ddns_fwd_name ddns_txt Returns: New Text::DHCPLeases::Object object Examples: my $lease = Text::DHCPLeases::Object->new(type => 'lease', ip_address => '192.168.1.10', starts => '3 2007/08/15 11:34:58', ends => '3 2007/08/15 11:44:58'); =cut ############################################################ =head2 parse - Parse object declaration Arguments: Array ref with declaration lines Returns: Hash reference. Examples: my $text = ' lease 192.168.254.55 { starts 3 2007/08/15 11:34:58; ends 3 2007/08/15 11:44:58; tstp 3 2007/08/15 11:49:58; tsfp 2 2007/08/14 21:24:19; cltt 3 2007/08/15 11:34:58; binding state active; next binding state expired; hardware ethernet 00:11:85:5d:4e:11; uid "\001\000\021\205]Nh"; client-hostname "blah"; }'; my $lease_data = Text::DHCPLeases::Lease->parse($text); =cut sub parse{ my ($self, $lines) = @_; my %obj; for ( @$lines ){ $_ =~ s/^\s+//o; $_ =~ s/\s+$//o; next if ( /^#|^$|\}$/o ); if ( /^lease ($IPV4) /o ){ $obj{type} = 'lease'; $obj{name} = $1; $obj{'ip_address'} = $1; }elsif ( /^(host|group|subgroup) (.*) /o ){ $obj{type} = $1; $obj{name} = $2; }elsif ( /^failover peer (.*) state/o ){ $obj{type} = 'failover-state'; $obj{name} = $1; }elsif ( /starts ($DATE);/o ){ $obj{starts} = $1; }elsif ( /ends ($DATE|never);/o ){ $obj{ends} = $1; }elsif ( /tstp ($DATE|never);/o ){ $obj{tstp} = $1; }elsif ( /atsfp ($DATE|never);/o ){ $obj{atsfp} = $1; }elsif ( /tsfp ($DATE|never);/o ){ $obj{tsfp} = $1; }elsif ( /cltt ($DATE);/o ){ $obj{cltt} = $1; }elsif ( /^next binding state (\w+);/o ){ $obj{'next_binding_state'} = $1; }elsif ( /^binding state (\w+);/o ){ $obj{'binding_state'} = $1; }elsif ( /^rewind binding state (\w+);/o ){ $obj{'rewind_binding_state'} = $1; }elsif ( /uid (\".*\");/o ){ $obj{uid} = $1; }elsif ( /client-hostname \"(.*)\";/o ){ $obj{'client_hostname'} = $1; }elsif ( /abandoned;/o ){ $obj{abandoned} = 1; }elsif ( /deleted;/o ){ $obj{deleted} = 1; }elsif ( /dynamic-bootp;/o ){ $obj{dynamic_bootp} = 1; }elsif ( /dynamic;/o ){ $obj{dynamic} = 1; }elsif ( /hardware (.+) (.*);/o ){ $obj{'hardware_type'} = $1; $obj{'mac_address'} = $2; }elsif ( /fixed-address (.*);/o ){ $obj{'fixed_address'} = $1; }elsif ( /option agent\.circuit-id (.*);/o ){ $obj{'option_agent_circuit_id'} = $1; }elsif ( /option agent\.remote-id (.*);/o ){ $obj{'option_agent_remote_id'} = $1; }elsif ( /set (\w+) = (.*);/o ){ $obj{set}{$1} = $2; }elsif ( /on (.*) \{(.*)\};/o ){ my $events = $1; my @events = split /\|/, $events; my $statements = $2; my @statements = split /\n;/, $statements; $obj{on}{events} = @events; $obj{on}{statements} = @statements; }elsif ( /bootp;/o ){ $obj{bootp} = 1; }elsif ( /reserved;/o ){ $obj{reserved} = 1; }elsif ( /failover peer \"(.*)\" state/o ){ $obj{name} = $1; }elsif ( /my state (.*) at ($DATE);/o ){ $obj{my_state} = $1; $obj{my_state_date} = $2; }elsif (/partner state (.*) at ($DATE);/o ){ $obj{partner_state} = $1; $obj{partner_state_date} = $2; }elsif (/mclt (\w+);/o ){ $obj{mclt} = $1; }elsif (/set ddns-rev-name = \"(.*)\";/o){ $obj{ddns_rev_name} = $1; }elsif (/set ddns-fwd-name = \"(.*)\";/o){ $obj{ddns_fwd_name} = $1; }elsif (/set ddns-txt = \"(.*)\";/o){ $obj{ddns_txt} = $1; }else{ carp "Text::DHCPLeases::Object::parse Error: Statement not recognized: '$_'\n"; } } return \%obj; } =head1 INSTANCE METHODS =cut ############################################################ =head2 print - Print formatted string with lease contents Arguments: None Returns: Formatted String Examples: print $obj->print; =cut sub print{ my ($self) = @_; my $out = ""; if ( $self->type eq 'lease' ){ $out .= sprintf("lease %s {\n", $self->ip_address); }elsif ( $self->type eq 'failover-state' ){ # These are printed with an extra carriage return in 3.1.0 $out .= sprintf("\nfailover peer %s state {\n", $self->name); }else{ $out .= sprintf("%s %s {\n", $self->type, $self->name); } $out .= sprintf(" starts %s;\n", $self->starts) if $self->starts; $out .= sprintf(" ends %s;\n", $self->ends) if $self->ends; $out .= sprintf(" tstp %s;\n", $self->tstp) if $self->tstp; $out .= sprintf(" tsfp %s;\n", $self->tsfp) if $self->tsfp; $out .= sprintf(" atsfp %s;\n", $self->atsfp) if $self->atsfp; $out .= sprintf(" cltt %s;\n", $self->cltt) if $self->cltt; $out .= sprintf(" binding state %s;\n", $self->binding_state) if $self->binding_state; $out .= sprintf(" next binding state %s;\n", $self->next_binding_state) if $self->next_binding_state; $out .= sprintf(" dynamic-bootp;\n") if $self->dynamic_bootp; $out .= sprintf(" dynamic;\n") if $self->dynamic; $out .= sprintf(" hardware %s %s;\n", $self->hardware_type, $self->mac_address) if ( $self->hardware_type && $self->mac_address ); $out .= sprintf(" uid %s;\n", $self->uid) if $self->uid; $out .= sprintf(" set ddns-rev-name = \"%s\";\n", $self->ddns_rev_name) if $self->ddns_rev_name; $out .= sprintf(" set ddns-txt = \"%s\";\n", $self->ddns_txt) if $self->ddns_txt; $out .= sprintf(" set ddns-fwd-name = \"%s\";\n", $self->ddns_fwd_name) if $self->ddns_fwd_name; $out .= sprintf(" fixed-address %s;\n", $self->fixed_address) if $self->fixed_address; $out .= sprintf(" abandoned;\n") if $self->abandoned; $out .= sprintf(" deleted;\n") if $self->abandoned; $out .= sprintf(" option agent.circuit-id %s;\n", $self->option_agent_circuit_id) if $self->option_agent_circuit_id; $out .= sprintf(" option agent.remote-id %s;\n", $self->option_agent_remote_id) if $self->option_agent_remote_id; if ( defined $self->set ){ foreach my $var ( keys %{ $self->set } ){ $out .= sprintf(" set %s = %s;\n", $var, $self->set->{$var}); } } if ( $self->on && $self->on->{events} && $self->on->{statements} ){ my $events = join '|', @{$self->on->{events}}; my $statements = join '\n;', @{$self->on->{statements}}; $out .= sprintf(" on %s { %s }", $events, $statements); } $out .= sprintf(" client-hostname \"%s\";\n", $self->client_hostname) if $self->client_hostname; # These are only for failover-state objects $out .= sprintf(" my state %s at %s;\n", $self->my_state, $self->my_state_date) if $self->my_state; $out .= sprintf(" partner state %s at %s;\n", $self->partner_state, $self->partner_state_date) if $self->partner_state; $out .= sprintf(" mclt %s;\n", $self->mclt) if $self->mclt; $out .= "}\n"; return $out; } # Make sure to return 1 1; =head1 AUTHOR Carlos Vicente =head1 LICENCE AND COPYRIGHT Copyright (c) 2012, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Text-DHCPLeases-1.0/lib/Text/DHCPLeases/Object/Iterator.pm000444 000765 000024 00000004433 12060407220 024007 0ustar00cvicentestaff000000 000000 package DHCPLeases::Object::Iterator; use strict; use warnings; use vars qw($VERSION); $VERSION = '1.0'; =head1 NAME Text::DHCPLeases::Object::Iterator - Lease object iterator class =head1 SYNOPSIS =head1 DESCRIPTION =cut sub new { my ($proto, $list) = @_; my $class = ref($proto) || $proto; my $self = {}; $self->{_list} = $list; $self->{_pos} = 0; $self->{_size} = scalar @{$self->{_list}}; bless $self, $class; } sub count { my ($self) = @_; return $self->{_size} }; sub first { my ($self) = @_; return $self->{_list}->[0]; } sub last { my ($self) = @_; return $self->{_list}->[$self->{_size} - 1]; } sub next { my ($self) = @_; return $self->{_list}->[$self->{_pos}++]; } # Make sure to return 1 1; =head1 AUTHOR Carlos Vicente, =head1 LICENCE AND COPYRIGHT Copyright (c) 2012, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut