view release on metacpan or  search on metacpan

ZoneFile.pm  view on Meta::CPAN

						}
					else
						{
						$hash{"TTL"}=$ttl;
						}
					}
				else
					{
					$hash{"TTL"}=$ttl;
					}
				shift(@record);
				}
			if(lc($record[0]) eq "in")
				{
				if($class)
					{
					$self->{"FAIL_REASON"}="Found two class definitions for RR.";
					return undef;
					}
				shift(@record);
				}
			$hash{"TTL"}=$self->{"CURRENT_TTL"} if(!defined($hash{"TTL"}));
			# by the time we get here, we should have @record containing just the RR
			if(ref($TYPES{uc($record[0])}))
				{
				$hash{"TYPE"}=uc(shift(@record));
				$hash{"RR_DATA"}=[];
				if($#record != $#{$TYPES{$hash{"TYPE"}}})
					{
					$self->{"FAIL_REASON"}="Argument inconsistency: expected ".
						($#{$TYPES{$hash{"TYPE"}}}+1)." arguments for ".$hash{"TYPE"}.
						" record, and got ".($#record+1)." arguments.";
					return undef;
					}
				for my $i (0..$#{$TYPES{$hash{"TYPE"}}})
					{
					my $part=canonicalise($self,$record[$i],${$TYPES{$hash{"TYPE"}}}[$i]);
					if(!defined($part))
						{
						$i++;
						$self->{"FAIL_REASON"}="Incorrect format for part '".$record[$i-1].
							"'($i) of RR for '".$hash{"DOMAIN"}."'.";
						return undef;
						}
					push(@{$hash{"RR_DATA"}},$part);
					}
				}
			else
				{
				$self->{"FAIL_REASON"}="Unknown RR type \"".uc($record[0])."\".";
				return undef;
				}
			}
		}
	return \%hash;
	}

#updateSerial
#   This function will update the serial number in the zone file loaded.

sub updateSerial
	{
	my $self=shift;

	my $snum;

# need to add some kind of check here.....

	for my $record (@{$self->{"RECORDS"}})
		{
		if($record->{"TYPE"} eq "SOA")
			{
			# read the current serial number;
			my($oyr,$omth,$oday,$onum)=unpack("a4a2a2a2",$record->{"RR_DATA"}->[2]);
			
			# read the time
			my @t=localtime();

			# is this another version today?
			if( ($t[5]+1900==$oyr) && ($t[4]+1==$omth) && ($t[3]==$oday) )
				{
				# Yes
				$snum=printWithZeros($oyr,4);
				$snum.=printWithZeros($omth,2);
				$snum.=printWithZeros($oday,2);
				$snum.=printWithZeros(++$onum,2);
				}
			else
				{
				# No
				$snum=printWithZeros($t[5]+1900,4);
				$snum.=printWithZeros($t[4]+1,2);
				$snum.=printWithZeros($t[3],2);
				$snum.=printWithZeros(0,2);
				}
			$record->{"RR_DATA"}->[2]=$snum;
			}
		}
	}

#printWithZeros
#   Utility function to print a number with enough zeros to fill the
#   passed width.
sub printWithZeros
	{
	my $num=shift;
	my $wdth=shift;

	# XXX: this must be horribly inefficient, not sure what the best
	# way to fix it is.
	$num+=0;
	return "0" x ($wdth - length($num)).$num;
	}

# canonicalise
#   This function turns an element of an RR into it's fully qualified and
#   unquoted form, checking that it conforms to the relevant syntax. It
#   returns the relevant text if it succeeds, or undef if the syntax fails.
sub canonicalise
	{
	my $self=shift;