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