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