1#!/usr/local/bin/perl -w 2###################################################################### 3# 4# DNS/Zone/Label.pm 5# 6# $Id: Label.pm,v 1.5 2003/02/04 15:37:35 awolf Exp $ 7# $Revision: 1.5 $ 8# $Author: awolf $ 9# $Date: 2003/02/04 15:37:35 $ 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::Label; 19 20use strict; 21 22my $VERSION = '0.85'; 23my $REVISION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); 24 25### 26# The label name is always relative to 27# the zone name. Default type is '' and 28# represents a comment. 29### 30sub new { 31 my($pkg, $label) = @_; 32 my $class = ref($pkg) || $pkg; 33 34 my $self = { 35 '_ID' => undef, 36 'LABEL' => $label, 37 'RECORDS' => [], 38 }; 39 40 bless($self, $class); 41 42 return $self; 43} 44 45sub id { 46 my($self, $id) = @_; 47 48 $self->{'_ID'} = $id if($id); 49 50 return($self->{'_ID'}); 51} 52 53sub label { 54 my($self, $label) = @_; 55 56 $self->{'LABEL'} = $label if($label); 57 58 return($self->{'LABEL'}); 59} 60 61sub add { 62 my($self, $record) = @_; 63 64 push @{ $self->{'RECORDS'} }, ($record); 65 66 return $record; 67 68} 69 70sub delete { 71 my($self, $record) = @_; 72 73 my $found = 0; 74 my @array = $self->records(); 75 76 for (my $i=0 ; $array[$i] ; $i++) { 77 if($array[$i] == $record) { 78 $found = 1; 79 splice @array, $i, 1; 80 } 81 } 82 83 $self->records(@array); 84 85 return $found ? $self : undef; 86} 87 88sub record { 89 my($self, $ref) = @_; 90 my $record; 91 92 if(exists $ref->{'ID'} && $ref->{'ID'}) { 93 map { $record = $_ if($_->id() eq $ref->{'ID'}) } $self->records(); 94 } 95 elsif(exists $ref->{'TYPE'} && $ref->{'TYPE'}) { 96 map { $record = $_ if($_->type() eq $ref->{'TYPE'}) } $self->records(); 97 } 98 99 return $record; 100} 101 102sub records { 103 my($self, @records) = @_; 104 105 $self->{'RECORDS'} = \@records if(scalar @records); 106 107 my @result = @{ $self->{'RECORDS'} } if(ref($self->{'RECORDS'}) eq 'ARRAY'); 108 109 return @result; 110} 111 112sub dump { 113 my($self, $format, $origin, $ttl_default) = @_; 114 115 my @records = $self->sort()->records(); 116 117 my $label = $self->{'LABEL'}; 118 $label =~ s/\.$origin\.*$//; 119 $label = '@' if($label eq $origin); 120 121 my $first = 1; 122 foreach my $record (@records) { 123 $label = $first ? $label : ''; 124 125 $record->dump($label, $format, $ttl_default); 126 127 $first = 0 if($record->type() ne ''); 128 } 129 130 return $self; 131} 132 133sub toXML { 134 my($self) = @_; 135 my $result; 136 137 $result .= qq(<Label id=") . $self->id() . qq(">\n); 138 $result .= qq(<Name>\n) . $self->label() . qq(</Name>\n); 139 140 map { $result .= $_->toXML() } $self->records(); 141 142 $result .= qq(</Label>\n); 143 144 return $result; 145} 146 147sub debug { 148 my($self) = @_; 149 150 return undef unless($self); 151 152 eval { 153 use Data::Dumper; 154 155 print Dumper($self); 156 }; 157 158 return $self; 159} 160 161sub sort { 162 my($self) = @_; 163 164 my @result = sort { 165 return 1 if($b->type() eq ''); 166 return -1 if($a->type() eq ''); 167 return 1 if($b->type() eq 'IN SOA'); 168 return -1 if($a->type() eq 'IN SOA'); 169 return 1 if($b->type() eq 'IN A'); 170 return -1 if($a->type() eq 'IN A'); 171 return 1 if($b->type() eq 'IN NS'); 172 return -1 if($a->type() eq 'IN NS'); 173 return 1 if($b->type() eq 'IN MX'); 174 return -1 if($a->type() eq 'IN MX'); 175 return 1 if($b->type() eq 'IN CNAME'); 176 return -1 if($a->type() eq 'IN CNAME'); 177 return 1 if($b->type() eq 'IN TXT'); 178 return -1 if($a->type() eq 'IN TXT'); 179 return 1 if($b->type() eq 'IN PTR'); 180 return -1 if($a->type() eq 'IN PTR'); 181 return 1 if($b->type() eq 'IN HINFO'); 182 return -1 if($a->type() eq 'IN HINFO'); 183 return 1 if($b->type() eq 'IN WKS'); 184 return -1 if($a->type() eq 'IN WKS'); 185 186 return 0; 187 } $self->records(); 188 189 $self->records(@result); 190 191 return $self; 192} 193 1941; 195 196__END__ 197 198=pod 199 200=head1 NAME 201 202Bind::Zone::Label - Label in a DNS Zone 203 204 205=head1 SYNOPSIS 206 207use DNS::Zone::Label; 208 209my $label = new DNS::Zone::Label($label_name_string); 210 211$label->sort(); 212$label->dump(); 213$label->debug(); 214 215 216=head1 ABSTRACT 217 218This class represents a label in the domain name service (DNS). 219 220 221=head1 DESCRIPTION 222 223A label has a name and can contain records. You can dump() the 224label using a standard format and you can use debug() to get an 225output from Data::Dumper that shows the object in detail 226including all referenced objects. 227 228 229=head1 AUTHOR 230 231Copyright (C)2001-2003 Andy Wolf. All rights reserved. 232 233This library is free software; you can redistribute it and/or 234modify it under the same terms as Perl itself. 235 236Please address bug reports and comments to: 237zonemaster@users.sourceforge.net 238 239 240=head1 SEE ALSO 241 242L<DNS::Zone>, L<DNS::Zone::Record>, L<DNS::Zone::File> 243 244 245=cut 246