File Coverage

blib/lib/DNS/Zone/Record.pm

Criterion	Covered	Total	%
statement	57	121	47.1
branch	19	64	29.6
condition	10	22	45.4
subroutine	8	21	38.1
pod	0	13	0.0
total	94	241	39.0

#!/usr/local/bin/perl -w
######################################################################
#
# DNS/Zone/Record.pm
#
# $Id: Record.pm,v 1.5 2003/02/04 15:37:35 awolf Exp $
# $Revision: 1.5 $
# $Author: awolf $
# $Date: 2003/02/04 15:37:35 $
#
# Copyright (C)2001-2003 Andy Wolf. All rights reserved.
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
######################################################################

package DNS::Zone::Record;

no warnings 'portable';
use 5.6.0;
use strict;
use warnings;

use vars qw($AUTOLOAD);

my $VERSION   = '0.85';
my $REVISION  = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);

my %fields = (
	OS         => undef,
	CPU        => undef,
	TTL        => undef,
	TYPE       => undef,
	TEXT       => undef,
	CNAME      => undef,
	EMAIL      => undef,
	RETRY      => undef,
	SERIAL     => undef,
	EXPIRE     => undef,
	DOMAIN     => undef,
	COMMENT    => undef,
	ADDRESS    => undef,
	NSERVER    => undef,
	REFRESH    => undef,
	MINIMUM    => undef,
	PROTOCOL   => undef,
	SERVICES   => undef,
	EXCHANGE   => undef,
	PREFERENCE => undef,
);

###
# Default type is  '' and  represents a
# comment. All other data is optional.
# When omitted TTL defaults to 0.
###
sub new {
	my($pkg, $ttl, $type, $data) = @_;
	my $class = ref($pkg) || $pkg;

	my $self = {
		'_ID' => undef,
	};

	$self->{'TYPE'} = $type || '';
	$self->{'TTL'}  = $ttl || 0;

	if($type eq 'IN A') {
		$self->{'ADDRESS'} = $data;
	}
	elsif($type eq 'IN CNAME') {
		$self->{'CNAME'} = lc $data;
		$self->{'CNAME'} =~ s/\.$//;
	}
	elsif($type eq 'IN HINFO') {
		(
			$self->{'CPU'},
			$self->{'OS'}
		) = split /\s+/, $data;
	}
	elsif($type eq 'IN MX') {
		($self->{'PREFERENCE'}, $self->{'EXCHANGE'}) = split /\s+/, $data;
		$self->{'PREFERENCE'} = lc $self->{'PREFERENCE'};
		$self->{'EXCHANGE'}   = lc $self->{'EXCHANGE'};
		$self->{'EXCHANGE'}   =~ s/\.$//;
	}
	elsif($type eq 'IN NS') {
		$self->{'NSERVER'} = lc $data;
		$self->{'NSERVER'} =~ s/\.$//;
	}
	elsif($type eq 'IN PTR') {
		$self->{'DOMAIN'} = lc $data;
		$self->{'DOMAIN'} =~ s/\.$//;
	}
	elsif($type eq 'IN SOA') {
		$data =~ s/\(|\)//g;

		(
			$self->{'NSERVER'},
			$self->{'EMAIL'},
			$self->{'SERIAL'},
			$self->{'REFRESH'},
			$self->{'RETRY'},
			$self->{'EXPIRE'},
			$self->{'MINIMUM'}
		) = split /\s+/, $data;

		$self->{'NSERVER'} = lc $self->{'NSERVER'};
		$self->{'NSERVER'} =~ s/\.$//;

		$self->{'EMAIL'}   = lc $self->{'EMAIL'};
		$self->{'EMAIL'}   =~ s/\.$//;

		$self->{'SERIAL'}  = lc $self->{'SERIAL'};
		$self->{'REFRESH'} = lc $self->{'REFRESH'};
		$self->{'RETRY'}   = lc $self->{'RETRY'};
		$self->{'EXPIRE'}  = lc $self->{'EXPIRE'};
		$self->{'MINIMUM'} = lc $self->{'MINIMUM'};
	}
	elsif($type eq 'IN TXT') {
		$self->{'TEXT'} = $data;
	}
	elsif($type eq 'IN WKS') {
		(
			$self->{'ADDRESS'},
			$self->{'PROTOCOL'},
			$self->{'SERVICES'}
		) = split /\s+/, $data;
	}
	else {
		$self->{'COMMENT'} = $data;
		$self->{'TYPE'}    = '';
	}

	bless $self, $class;

	return $self;
}

# The id shall only be used to search if
# the backend allows to use ids more
# efficiently. Setting this attribute
# should only be done when reading/writing
# from/to the backend (e.g. database)
########################################
sub id {
   my($self, $id) = @_;

   $self->{'_ID'} = $id if($id);

   return($self->{'_ID'});
}

sub data {
	my($self) = @_;

	my $type = $self->type();

	if($type eq 'IN SOA') {
		return(
			$self->nserver() . ". " .
			$self->email()   . ". " .
			$self->serial()  . " " .
			$self->refresh() . " " .
			$self->retry()   . " " .
			$self->expire()  . " " .
			$self->minimum()
		);
	}
	elsif($type eq 'IN A') {
		return(
			$self->address()
		);
	}
	elsif($type eq 'IN NS') {
		return(
			$self->nserver() . "."
		);
	}
	elsif($type eq 'IN MX') {
		return(
			$self->preference() . " " .
			$self->exchange() . "."
		);
	}
	elsif($type eq 'IN CNAME') {
		return(
			$self->cname() . "."
		);
	}
	elsif($type eq 'IN HINFO') {
		return(
			$self->cpu() . " " .
			$self->os()
		);
	}
	elsif($type eq 'IN PTR') {
		return(
			$self->domain()
		);
	}
	elsif($type eq 'IN TXT') {
		return(
			$self->text()
		);
	}
	elsif($type eq 'IN WKS') {
		return(
			$self->address() . " " .
			$self->protocol() . " " .
			$self->services()
		);
	}
	else {
		return(
			"; " . $self->comment()
		);
	}

	return undef;
}

sub dump {
	my($self, $label, $format, $ttl_default) = @_;

	my $ttlstring = ($self->ttl() == $ttl_default) ? '' : $self->ttl();

	if($self->type() eq 'IN SOA') {
		printf "$format %s IN SOA    %s. %s. \(\n", $label, $ttlstring, $self->nserver(), $self->email();
		printf "$format           %s ; Serial\n" , '', $self->serial();
		printf "$format           %s ; Refresh\n", '', $self->refresh();
		printf "$format           %s ; Retry\n"  , '', $self->retry();
		printf "$format           %s ; Expire\n" , '', $self->expire();
		printf "$format           %s ; Minimum\n", '', $self->minimum();
		printf "$format  \)", '';
		print " " if($self->comment());
	}
	elsif($self->type() ne '') {
		my $out_format = "$format %s %-9s %s";
		printf $out_format, $label, $ttlstring, $self->type(), $self->data();
		print " " if($self->comment());
	}

	print "; " . $self->comment() if($self->comment());
	print "\n";

	return $self;
}

sub toXML {
	my($self) = @_;
	my $result;

	$result .= qq(\n);
	$result .= qq()        . $self->ttl()  . qq(\n);
	$result .= qq()       . $self->type() . qq(\n);
	$result .= qq()    . $self->data() . qq(\n);
	$result .= qq(\n);

	return $result;
}

sub debug {
	my($self) = @_;

	eval {
		use Data::Dumper;

		print Dumper($self);
	};

	return $self;
}

sub AUTOLOAD {
	my($self, $value) = @_;
	my $type = ref($self) or die "$self is not an object";

	my $name = $AUTOLOAD;
	$name =~ s/.*://;
	$name =~ tr/a-z/A-Z/;

	die "Can't access `$name' field in class $type" unless (exists $fields{$name});

	if(($name eq 'CNAME') ||
		($name eq 'EMAIL') ||
		($name eq 'DOMAIN') ||
		($name eq 'NSERVER') ||
		($name eq 'EXCHANGE')
	) {
		$value = lc $value;
	}

	if ($value) {
		if(($name eq 'TYPE') || ($name eq 'COMMENT')) {
			die "Read-only attribute `$name' in class $type";
		}

		return $self->{$name} = $value;
	} else {
		return $self->{$name};
	}
}

sub DESTROY {
}

sub check {
	my($self) = @_;

	#unless(isipaddr($self->{address})) {}
	#unless(isrealhost($self->{cname}) {}
	#0 <= $self->{preference} <= 65535
	#unless(isrealhost{$self->{exchange}) {}
	#unless(isrealhost{$self->{nserver}) {}
	#unless(isrealhost{$self->{domain}) {}
	#unless(isrealhost{$self->{nserver}) {}
	#unless(isemail($self->{email}) {}
	# 0 <= $self->{serial} <= 4294967295
	#unless(abs($self->{serial}) == $self->{serial}) {}
	#unless($self->{serial} > 1995000000) {}
	# 0 <= $self->{refresh} <= 4294967295
	# 0 <= $self->{retry} <= 4294967295
	# 0 <= $self->{expire} <= 4294967295
	# 0 <= $self->{minimum} <= 4294967295

	return undef;
}

sub isipaddr {
	/^(\s+)\.(\s+)\.(\s+)\.(\s+)\.$/;
}

sub isreverseip {
	/\.in-addr\.arpa$/i;
}

sub isrealhost {
	#test for existance
	#might use ping and/or dig
}

sub isemail {
	/[\w\-]+\@([\w\-]+\.)+[\w\-]+/;
}

sub is32bit {
	($_[0] >= 0) && ($_[0] <= 4294967295);
}

sub is16bit {
	($_[0] >= 0) && ($_[0] <= 65535);
}

1;

__END__