1#!/usr/local/bin/perl -w
2######################################################################
3#
4# DNS/Zone.pm
5#
6# $Id: Zone.pm,v 1.7 2003/02/04 15:22:12 awolf Exp $
7# $Revision: 1.7 $
8# $Author: awolf $
9# $Date: 2003/02/04 15:22:12 $
10#
11# Copyright (C)2001-2003 Andy Wolf. All rights reserved.
12#
13# This library is free software; you can redistribute it and/or
14# modify it under the same terms as Perl itself.
15#
16######################################################################
17
18package DNS::Zone;
19
20use strict;
21
22use vars qw($AUTOLOAD);
23
24my $VERSION   = '0.85';
25my $REVISION  = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
26
27sub new {
28	my($pkg, $name) = @_;
29	my $class = ref($pkg) || $pkg;
30
31	my $self = {
32      '_ID'    => undef,
33		'NAME'   => $name,
34		'LABELS' => [],
35	};
36
37	bless $self, $class;
38
39	return $self;
40}
41
42# The id shall only be used to search if
43# the backend allows to use ids more
44# efficiently. Setting this attribute
45# should only be done when reading/writing
46# from/to the backend (e.g. database)
47########################################
48sub id {
49   my($self, $id) = @_;
50
51   $self->{'_ID'} = $id if($id);
52
53   return($self->{'_ID'});
54}
55
56sub name {
57	my($self, $name) = @_;
58
59	$self->{'NAME'} = $name if($name);
60
61	return($self->{'NAME'});
62}
63
64#May be used to store a reference to some super
65#object like a master server.
66sub master {
67	my($self, $ref) = @_;
68
69	$self->{'MASTER'} = $ref if($ref);
70
71	return $self->{'MASTER'};
72}
73
74sub add {
75	my($self, $label) = @_;
76
77	push @{ $self->{'LABELS'} }, ($label);
78
79	return $label;
80}
81
82sub delete {
83	my($self, $record) = @_;
84
85	my $found = 0;
86
87	foreach my $label ($self->labels()) {
88		my @array = $label->records();
89
90		for (my $i=0 ; $array[$i] ; $i++) {
91			if($array[$i] == $record) {
92				$found = 1;
93				splice @array, $i, 1;
94			}
95		}
96
97		$label->records(@array);
98	}
99
100	return $found ? $self : undef;
101}
102
103sub label {
104   my($self, $ref) = @_;
105	my $label;
106
107	if(exists $ref->{'NAME'} && $ref->{'NAME'}) {
108	  	for ($self->labels()) {
109   		$label = $_ if($_->label() eq $ref->{'NAME'});
110	  	}
111	}
112	elsif(exists $ref->{'ID'} && $ref->{'ID'}) {
113	  	for ($self->labels()) {
114   		$label = $_ if($_->id() eq $ref->{'ID'});
115	  	}
116	}
117
118   return $label;
119}
120
121sub labels {
122	my($self, @labels) = @_;
123
124	$self->{'LABELS'} = \@labels if(scalar @labels);
125
126	my @result = @{ $self->{'LABELS'} } if(ref($self->{'LABELS'}) eq 'ARRAY');
127
128	return @result;
129}
130
131sub sort {
132	my($self) = @_;
133
134	my @result = sort {
135		my(@a) = reverse split /\./, $a->label();
136		my(@b) = reverse split /\./, $b->label();
137
138		for(my $i=0 ; $a[$i] || $b[$i] ; $i++) {
139			if($a[$i] && $b[$i]) {
140				return ($a[$i] cmp $b[$i]) if($a[$i] cmp $b[$i]);
141			}
142			elsif($a[$i] && !$b[$i]) {
143				return 1;
144			}
145			elsif(!$a[$i] && $b[$i]) {
146				return -1;
147			}
148			else {
149				return 0;
150			}
151		}
152
153		return 0;
154	} $self->labels();
155
156   $self->labels(@result);
157
158   return $self;
159}
160
161sub dump {
162	my($self) = @_;
163
164	my %ttl_hash;
165	my $labellength = 0;
166	for my $label ($self->sort()->labels()) {
167		my $length = length $label->label();
168		$labellength = $length if($length > $labellength);
169
170		my @records = $label->records();
171
172		for (@records) {
173			my $ttl = $_->ttl();
174
175			if(exists $ttl_hash{$ttl}) {
176				$ttl_hash{$ttl} += 1;
177			}
178			else {
179				$ttl_hash{$ttl} = 1;
180			}
181		}
182	}
183
184	my $ttl_default = 0;
185	my $ttl_max = 0;
186	for (keys %ttl_hash) {
187		$ttl_default = $_ if($ttl_hash{$_} > $ttl_max);
188	}
189
190	my $origin = $self->name();
191
192	print '$TTL ', "$ttl_default\n";
193	print '$ORIGIN ', "$origin\.\n";
194
195	foreach my $label ($self->labels()) {
196		print "\n";
197		$label->dump("%-" . $labellength . "s", $origin, $ttl_default);
198	}
199
200	return $self;
201}
202
203sub toXML {
204	my($self) = @_;
205	my $result;
206
207	$result .= qq(<Zone id=") . $self->id() . qq(" managed="1">\n);
208	$result .= qq(<Name>\n) . $self->name() . qq(</Name>\n);
209
210	map { $result .= $_->toXML() } $self->labels();
211
212	$result .= qq(</Zone>\n);
213
214	return $result;
215}
216
217sub debug {
218   my($self) = @_;
219
220	eval {
221		use Data::Dumper;
222
223		print Dumper($self);
224	};
225
226   return $self;
227}
228
2291;
230
231__END__
232
233=pod
234
235=head1 NAME
236
237Bind::Zone - DNS Zone
238
239
240=head1 SYNOPSIS
241
242use DNS::Zone;
243
244my $zone = new DNS::Zone($zone_name_string);
245
246$zone->sort();
247$zone->dump();
248$zone->debug();
249
250
251=head1 ABSTRACT
252
253This class represents a zone in the domain name service (DNS).
254
255
256=head1 DESCRIPTION
257
258A zone has a name and can contain labels. You can dump() the
259zone use a standard format and you can use debug() to get an
260output from Data::Dumper that shows the object in detail
261including all referenced objects.
262
263
264=head1 AUTHOR
265
266Copyright (C)2001-2003 Andy Wolf. All rights reserved.
267
268This library is free software; you can redistribute it and/or
269modify it under the same terms as Perl itself.
270
271Please address bug reports and comments to:
272zonemaster@users.sourceforge.net
273
274
275=head1 SEE ALSO
276
277L<DNS::Zone::Label>, L<DNS::Zone::Record>, L<DNS::Zone::File>
278
279
280=cut
281