1package Text::DHCPLeases::Object; 2 3use warnings; 4use strict; 5use Carp; 6use Class::Struct; 7use vars qw($VERSION); 8$VERSION = '1.0'; 9 10# IPv4 regular expression 11my $IPV4 = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}'; 12 13# weekday year/month/day hour:minute:second 14my $DATE = '\d+ \d{4}\/\d{2}\/\d{2} \d{2}:\d{2}:\d{2}'; 15 16=head1 NAME 17 18Text::DHCPLeases::Object - Leases Object Class 19 20=head1 SYNOPSIS 21 22my $obj = Text::DHCPLeases::Object->parse($string); 23 24or 25 26my $obj = Text::DHCPLeases::Object->new(%lease_data); 27 28print $obj->name; 29print $obj->type; 30print $obj->binding_state; 31 32=head1 DESCRIPTION 33 34DHCPLeases object class. Lease objects can be one of the following types: 35 36 lease 37 host 38 group 39 subgroup 40 failover-state 41 42=cut 43 44struct ( 45'type' => '$', 46'name' => '$', 47'ip_address' => '$', 48'fixed_address' => '$', 49'starts' => '$', 50'ends' => '$', 51'tstp' => '$', 52'tsfp' => '$', 53'atsfp' => '$', 54'cltt' => '$', 55'next_binding_state' => '$', 56'binding_state' => '$', 57'uid' => '$', 58'client_hostname' => '$', 59'abandoned' => '$', 60'deleted' => '$', 61'dynamic_bootp' => '$', 62'dynamic' => '$', 63'option_agent_circuit_id' => '$', 64'option_agent_remote_id' => '$', 65'hardware_type' => '$', 66'mac_address' => '$', 67'set' => '%', 68'on' => '%', 69'bootp' => '$', 70'reserved' => '$', 71'my_state' => '$', 72'my_state_date' => '$', 73'partner_state' => '$', 74'partner_state_date' => '$', 75'mclt' => '$', 76'ddns_rev_name' => '$', 77'ddns_fwd_name' => '$', 78'ddns_txt' => '$' 79); 80 81=head1 CLASS METHODS 82 83=head2 new - Constructor 84 85 Arguments: 86 type one of (lease|host|group|subgroup|failover-state) 87 name identification string (address, host name, group name, etc) 88 ip_address 89 fixed_address 90 starts 91 ends 92 tstp 93 tsfp 94 atsfp 95 cltt 96 next_binding_state 97 binding_state 98 uid 99 client_hostname 100 abandoned (flag) 101 deleted (flag) 102 dynamic_bootp (flag) 103 dynamic (flag) 104 option_agent_circuit_id 105 option_agent_remote_id 106 hardware_type 107 mac_address 108 set (hash) 109 on (hash) 110 bootp (flag) 111 reserved (flag) 112 my_state 113 my_state_date 114 partner_state 115 partner_state_date 116 mclt 117 dns_rev_name 118 ddns_fwd_name 119 ddns_txt 120 Returns: 121 New Text::DHCPLeases::Object object 122 Examples: 123 124 my $lease = Text::DHCPLeases::Object->new(type => 'lease', 125 ip_address => '192.168.1.10', 126 starts => '3 2007/08/15 11:34:58', 127 ends => '3 2007/08/15 11:44:58'); 128 129=cut 130 131############################################################ 132=head2 parse - Parse object declaration 133 134Arguments: 135 Array ref with declaration lines 136Returns: 137 Hash reference. 138 Examples: 139 140 my $text = ' 141lease 192.168.254.55 { 142 starts 3 2007/08/15 11:34:58; 143 ends 3 2007/08/15 11:44:58; 144 tstp 3 2007/08/15 11:49:58; 145 tsfp 2 2007/08/14 21:24:19; 146 cltt 3 2007/08/15 11:34:58; 147 binding state active; 148 next binding state expired; 149 hardware ethernet 00:11:85:5d:4e:11; 150 uid "\001\000\021\205]Nh"; 151 client-hostname "blah"; 152}'; 153 154my $lease_data = Text::DHCPLeases::Lease->parse($text); 155=cut 156sub parse{ 157 my ($self, $lines) = @_; 158 my %obj; 159 for ( @$lines ){ 160 $_ =~ s/^\s+//o; 161 $_ =~ s/\s+$//o; 162 next if ( /^#|^$|\}$/o ); 163 if ( /^lease ($IPV4) /o ){ 164 $obj{type} = 'lease'; 165 $obj{name} = $1; 166 $obj{'ip_address'} = $1; 167 }elsif ( /^(host|group|subgroup) (.*) /o ){ 168 $obj{type} = $1; 169 $obj{name} = $2; 170 }elsif ( /^failover peer (.*) state/o ){ 171 $obj{type} = 'failover-state'; 172 $obj{name} = $1; 173 }elsif ( /starts ($DATE);/o ){ 174 $obj{starts} = $1; 175 }elsif ( /ends ($DATE|never);/o ){ 176 $obj{ends} = $1; 177 }elsif ( /tstp ($DATE|never);/o ){ 178 $obj{tstp} = $1; 179 }elsif ( /atsfp ($DATE|never);/o ){ 180 $obj{atsfp} = $1; 181 }elsif ( /tsfp ($DATE|never);/o ){ 182 $obj{tsfp} = $1; 183 }elsif ( /cltt ($DATE);/o ){ 184 $obj{cltt} = $1; 185 }elsif ( /^next binding state (\w+);/o ){ 186 $obj{'next_binding_state'} = $1; 187 }elsif ( /^binding state (\w+);/o ){ 188 $obj{'binding_state'} = $1; 189 }elsif ( /^rewind binding state (\w+);/o ){ 190 $obj{'rewind_binding_state'} = $1; 191 }elsif ( /uid (\".*\");/o ){ 192 $obj{uid} = $1; 193 }elsif ( /client-hostname \"(.*)\";/o ){ 194 $obj{'client_hostname'} = $1; 195 }elsif ( /abandoned;/o ){ 196 $obj{abandoned} = 1; 197 }elsif ( /deleted;/o ){ 198 $obj{deleted} = 1; 199 }elsif ( /dynamic-bootp;/o ){ 200 $obj{dynamic_bootp} = 1; 201 }elsif ( /dynamic;/o ){ 202 $obj{dynamic} = 1; 203 }elsif ( /hardware (.+) (.*);/o ){ 204 $obj{'hardware_type'} = $1; 205 $obj{'mac_address'} = $2; 206 }elsif ( /fixed-address (.*);/o ){ 207 $obj{'fixed_address'} = $1; 208 }elsif ( /option agent\.circuit-id (.*);/o ){ 209 $obj{'option_agent_circuit_id'} = $1; 210 }elsif ( /option agent\.remote-id (.*);/o ){ 211 $obj{'option_agent_remote_id'} = $1; 212 }elsif ( /set (\w+) = (.*);/o ){ 213 $obj{set}{$1} = $2; 214 }elsif ( /on (.*) \{(.*)\};/o ){ 215 my $events = $1; 216 my @events = split /\|/, $events; 217 my $statements = $2; 218 my @statements = split /\n;/, $statements; 219 $obj{on}{events} = @events; 220 $obj{on}{statements} = @statements; 221 }elsif ( /bootp;/o ){ 222 $obj{bootp} = 1; 223 }elsif ( /reserved;/o ){ 224 $obj{reserved} = 1; 225 }elsif ( /failover peer \"(.*)\" state/o ){ 226 $obj{name} = $1; 227 }elsif ( /my state (.*) at ($DATE);/o ){ 228 $obj{my_state} = $1; 229 $obj{my_state_date} = $2; 230 }elsif (/partner state (.*) at ($DATE);/o ){ 231 $obj{partner_state} = $1; 232 $obj{partner_state_date} = $2; 233 }elsif (/mclt (\w+);/o ){ 234 $obj{mclt} = $1; 235 }elsif (/set ddns-rev-name = \"(.*)\";/o){ 236 $obj{ddns_rev_name} = $1; 237 }elsif (/set ddns-fwd-name = \"(.*)\";/o){ 238 $obj{ddns_fwd_name} = $1; 239 }elsif (/set ddns-txt = \"(.*)\";/o){ 240 $obj{ddns_txt} = $1; 241 }else{ 242 carp "Text::DHCPLeases::Object::parse Error: Statement not recognized: '$_'\n"; 243 } 244 } 245 return \%obj; 246} 247 248=head1 INSTANCE METHODS 249=cut 250 251############################################################ 252=head2 print - Print formatted string with lease contents 253 254 Arguments: 255 None 256 Returns: 257 Formatted String 258 Examples: 259 print $obj->print; 260=cut 261sub print{ 262 my ($self) = @_; 263 my $out = ""; 264 if ( $self->type eq 'lease' ){ 265 $out .= sprintf("lease %s {\n", $self->ip_address); 266 }elsif ( $self->type eq 'failover-state' ){ 267 # These are printed with an extra carriage return in 3.1.0 268 $out .= sprintf("\nfailover peer %s state {\n", $self->name); 269 }else{ 270 $out .= sprintf("%s %s {\n", $self->type, $self->name); 271 } 272 $out .= sprintf(" starts %s;\n", $self->starts) if $self->starts; 273 $out .= sprintf(" ends %s;\n", $self->ends) if $self->ends; 274 $out .= sprintf(" tstp %s;\n", $self->tstp) if $self->tstp; 275 $out .= sprintf(" tsfp %s;\n", $self->tsfp) if $self->tsfp; 276 $out .= sprintf(" atsfp %s;\n", $self->atsfp) if $self->atsfp; 277 $out .= sprintf(" cltt %s;\n", $self->cltt) if $self->cltt; 278 $out .= sprintf(" binding state %s;\n", $self->binding_state) 279 if $self->binding_state; 280 $out .= sprintf(" next binding state %s;\n", $self->next_binding_state) 281 if $self->next_binding_state; 282 $out .= sprintf(" dynamic-bootp;\n") if $self->dynamic_bootp; 283 $out .= sprintf(" dynamic;\n") if $self->dynamic; 284 $out .= sprintf(" hardware %s %s;\n", $self->hardware_type, $self->mac_address) 285 if ( $self->hardware_type && $self->mac_address ); 286 $out .= sprintf(" uid %s;\n", $self->uid) if $self->uid; 287 $out .= sprintf(" set ddns-rev-name = \"%s\";\n", $self->ddns_rev_name) if $self->ddns_rev_name; 288 $out .= sprintf(" set ddns-txt = \"%s\";\n", $self->ddns_txt) if $self->ddns_txt; 289 $out .= sprintf(" set ddns-fwd-name = \"%s\";\n", $self->ddns_fwd_name) if $self->ddns_fwd_name; 290 $out .= sprintf(" fixed-address %s;\n", $self->fixed_address) if $self->fixed_address; 291 $out .= sprintf(" abandoned;\n") if $self->abandoned; 292 $out .= sprintf(" deleted;\n") if $self->abandoned; 293 $out .= sprintf(" option agent.circuit-id %s;\n", $self->option_agent_circuit_id) 294 if $self->option_agent_circuit_id; 295 $out .= sprintf(" option agent.remote-id %s;\n", $self->option_agent_remote_id) 296 if $self->option_agent_remote_id; 297 if ( defined $self->set ){ 298 foreach my $var ( keys %{ $self->set } ){ 299 $out .= sprintf(" set %s = %s;\n", $var, $self->set->{$var}); 300 } 301 } 302 if ( $self->on && $self->on->{events} && $self->on->{statements} ){ 303 my $events = join '|', @{$self->on->{events}}; 304 my $statements = join '\n;', @{$self->on->{statements}}; 305 $out .= sprintf(" on %s { %s }", $events, $statements); 306 307 } 308 $out .= sprintf(" client-hostname \"%s\";\n", $self->client_hostname) if $self->client_hostname; 309 # These are only for failover-state objects 310 $out .= sprintf(" my state %s at %s;\n", $self->my_state, $self->my_state_date) 311 if $self->my_state; 312 $out .= sprintf(" partner state %s at %s;\n", $self->partner_state, $self->partner_state_date) 313 if $self->partner_state; 314 $out .= sprintf(" mclt %s;\n", $self->mclt) if $self->mclt; 315 $out .= "}\n"; 316 return $out; 317} 318 319 320# Make sure to return 1 3211; 322 323=head1 AUTHOR 324 325Carlos Vicente <cvicente@cpan.org> 326 327 328=head1 LICENCE AND COPYRIGHT 329 330Copyright (c) 2012, Carlos Vicente <cvicente@cpan.org>. All rights reserved. 331 332This module is free software; you can redistribute it and/or 333modify it under the same terms as Perl itself. See L<perlartistic>. 334 335 336=head1 DISCLAIMER OF WARRANTY 337 338BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 339FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 340OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 341PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER 342EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 343WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 344ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH 345YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL 346NECESSARY SERVICING, REPAIR, OR CORRECTION. 347 348IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 349WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 350REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE 351LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, 352OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE 353THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 354RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 355FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 356SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 357SUCH DAMAGES. 358=cut 359