Net::DNS::Zone::Parser - A Zone Pre-Parser

   my $parser=Net::DNS::Zone::Parser->new($io);

   my $io=$parser->get_io;
   $io->seek(0,0);
   print while (< $io >);

    my $parser=Net::DNS::Zone::Parser->new;
    $parser->read("/tmp/example.foo");
    $parser->read("/tmp/foo.db",
		{ ORIGIN => "example.db",
		  };

    $returnval=$parser->read("/tmp/foo.db",
		{ ORIGIN => "example.db",
                  CREATE_RR => 1,
		  STRIP_SEC => 1,
		  };
    if ($returnval) {
         die $returnval;
    }else{
         $RRarrayref=$parser->get_array();
    }

    my $origin=$parser->get_origin;

  use Net::DNS::Zone::Parser (processGENERATEarg)
  $generated=processGENERATEarg(0.0.${1,3},5,"inaddr.arpa."

# $Id: Parser.pm 788 2008-12-30 17:49:48Z olaf $
# Net::DNS::Zone::Parser
#
# O-O package that implements an RFC complient zone file (pre)parser.
#
# perldoc Net::DNS::Zone::Parser for details
#


package Net::DNS::Zone::Parser;

use strict;
use vars qw (
	     $VERSION
	     $REVISION
	     @ISA
	     @EXPORT_OK
	     $ZONE_RR_REGEX
	     $NAMED_COMPILEZONE
	     );


use File::Basename;
use Carp;
use File::Temp;
use IO::File;
use IO::Handle;
use Net::DNS;
use Net::DNS::RR;
use Shell qw (which);


BEGIN{
    require Exporter;
    @ISA = qw(Exporter);
    $VERSION = '0.02' ; 
    $REVISION =   (qw$LastChangedRevision: 788 $)[1];

    @EXPORT_OK   = qw (
		   processGENERATEarg
		  );
}




BEGIN
{

    $NAMED_COMPILEZONE = eval { 
	which("named-compilezone") || return(0);
	open(NAMEDV, "named-compilezone -v |") || return (0);
	my $namedv=<NAMEDV>;
	$namedv=~ /^(\d+)\.(\d+)\./;

	(($1>=9) && ($2 >= 4)) || return(0);

	$namedv;
    };
}





# Debugging during code development ... Anything greater than 0 will
# cause debugging output.
use constant DEBUG => 0;

my $debug=DEBUG;

my $MaxIncludeDepth=20;  # maximum time $INCLUDE recursion.

############
#
#  The ZONE_RR_REGEX all classes and types known by Net::DNS::RR and creates
#  a regexp to match input against. 
#  
#  This way we match against all know RRs at least those known to 
#  Net::DNS
#


# the classes regexp component we need elsewhere in the code as well
my $classes = join('|', keys %Net::DNS::classesbyname, 'CLASS\\d+');


build_regex() unless $ZONE_RR_REGEX;

# This code is simalar but not equal to the Net::DNS::RR function.
# The resulting regexp is just slightly different.
sub build_regex {

    # Longest ones go first, so the regex engine will match AAAA before A.
    my $types   = join('|', sort { length $b <=> length $a } keys %Net::DNS::typesbyname);

    $types .= '|TYPE\\d+';
                                
    $ZONE_RR_REGEX   = " ^ 
                                                                                \\s*
                                        (\\S+)+     # name anything non-space will do 
                                        \\s*                
                                        (\\d+)?           
                                        \\s*
                                        ($classes)?
                                        \\s*
                                        ($types)    # There must be a type specified.
                                        \\s*
                                        (.*)
                                        \$";

       print STDERR "Regex: $ZONE_RR_REGEX\n" if DEBUG;
}


###################
#
# new constructor method.
# See perldoc for arguments
# returns blesssed hash or dies.

sub new
{
    my ($caller, $argument)=@_;
    my $class=ref($caller)||$caller;
    my $self={};
    bless ($self,$class);

    if ($argument){
	    print "new called with an argument\n" if $debug;
	if ($argument->isa("IO::Handle")){
	    $self->{"fh"}=$argument;
	}else{
	    die 'Failure: supplied argument is not an instance of IO::File, IO::Handle or related i.o.w. isa( IO::Handle) failed';
	}
    }else{
	$self->{"fh"}=IO::File->new_tmpfile;
    }
    return $self;
}




#

############################
# read method
# See perldoc for details

sub read {
    my $self=shift;
    my $possible_filename=shift;
    my $arghash=shift;

    my $origin=$arghash->{"ORIGIN"};

    if ($arghash->{"CREATE_RR"}){
	$self->{create_rr}=[];
    }

    if ($arghash->{"STRIP_SEC"}){
	$self->{strip_dnskey}=1;
	$self->{strip_nsec}=1;
	$self->{strip_rrsig}=1;
    }

    if ($arghash->{"STRIP_DNSKEY"}){
	$self->{strip_dnskey}=1;

    }

    if ($arghash->{"STRIP_NSEC"}){
	$self->{strip_nsec}=1;

    }
    if ($arghash->{"STRIP_RRSIG"}){
	$self->{strip_rrsig}=1;

    }


    if ($arghash->{"STRIP_OLD"}){
	$self->{strip_old}=1;

    }

    $self->{bump_soa}=0;
    if ($arghash->{"BUMP_SOA"}){
	$self->{bump_soa}=1;

    }




    my $fh=$self->{"fh"};

    my @filename=glob($possible_filename);
    return "READ FAILURE: ambigueous input: ". join " ", @filename ."\n" if (@filename > 1);
    $self->{'filename'}=$filename[0];

    if (defined ($origin) && $origin=~/\S+/o) {
	# Strip spaces from begin and end of string.
	$origin=~s/\s//og;
        $self->{'_origin'}=$origin;
    }else{
	$self->{'_origin'} = basename($filename[0]);
    }


    $self->{'IncludeRecursionDetector'}=0;
    $self->{'DefaultTTLDirectiveFound'}=0;
    $self->{'_origin'}.="." if $self->{'_origin'}!~ /\.$/o;
    my $returnval=$self->_read($fh,$filename[0],$self->get_origin,'',0);
    return $returnval if $returnval =~ /^READ FAILURE:/o;

    return 0;
}



sub _read {

    my $self=shift;
    my $fh_out=shift;     # Filehandle to print parsed output to
    my $filename=shift;  # Filename of file to be read
    my $lastseenORIGIN=shift;  # Relevant to relative domains
    my $previousdname=shift;  # Relevant during $INCLUDE
    my $lastseenTTL=shift;
    print ";; _read method called on $filename with origin $lastseenORIGIN\n" if $debug;


    my $namedcomp_return;
    $namedcomp_return=$self->_read_namedcomp($fh_out,$filename,$lastseenORIGIN) if ($NAMED_COMPILEZONE);
    print "namedcomp_return returned:  $namedcomp_return\n" if $debug;
    if (defined($namedcomp_return)){
	if ($namedcomp_return eq "success"){
	    return "success";    
	}else{
	    # Only if the command failed to execute we'll continue with the "perl code";
	    return("READ FAILURE: from named-compilezone: $namedcomp_return") unless  $namedcomp_return=~/Failed to execute/;
	}
    }


    $self->{"IncludeRecursionDetector"}++;     # Used for testing INCLUDE LOOPS
    my $fh_in = new IO::File;
    $fh_in->open("< $filename" ) || return "READ FAILURE: Could not open $filename\n";

    $lastseenORIGIN.="." if $lastseenORIGIN !~/\.$/o;


    my $TTL=0;
    my $defaultTTL=0;


    #  The following loop parses the zone file. At the end of the
    #  paring logic the $_ contains "name TTL CLASS RTYPE RDATA" whith
    #  all variables set and all names expanded to FQDN.
    #
    #  During the loop the APEX keyset and it's signatures are removed.
    # Check RFC1035 section 5 for details on how to handle INCLUDES
    # and how the lastseenORIGIN propagates

    my $buffer='';
    my $openingbracketfound=0;
    

  READLINE: while (<$fh_in>){
      next READLINE if /^\s*$/o ;     # All spaces
      print "LINE: >". $_ if DEBUG>1;
      print "BUFF: >". $buffer."\n\n" if DEBUG>9;
      my $i=0;   # i is a counter to prevent overruns in multiline RRs

      # Start parsing the line 'token' by 'token'. 
      # As long as there are non whitespace tokens on the 
      # end of the line then (.*)$ matches those.
      #
      # $1 either contains a single whitespace or 
      # the longest nonwhitespace collection of characters 

      # Only go through char-by-char lineparsing if there
      # are parenthesis, quotes or comments or if we are parsing multilines
      if ( $openingbracketfound ||
	   /\(/o ||                       # Opening bracket
	   /\;/o ||                       # Comment at end of line
	   /\"/o ||                       # Quote
	   /\)/o                          # Closing bracket
	 ){

	LINEPARSE: while ( s/^(.)(.*)$/$2/o   && $i<200){   # no more than 200
                                                           # lines for multi-
                                                           # line RRs
	      print "LINE: ". $_ if DEBUG>10;
	      print "BUFF: ". $buffer."\n\n" if DEBUG>10;

	      my $char=$1;
	      if ( $char eq ';' ){
		  # rest of line is a comment...
		  if ($openingbracketfound) {
		      next READLINE;
		  }else{
		      next READLINE if $buffer=~s/^\s*$//o ;  # buffer only
		                                             # contains spaces
		      last LINEPARSE;
		  }
	      }elsif ( $char eq '(' ){
		  # Maybe we are to strict here and we should just ignore this
		  return  "READ FAILURE: Multiple enclosing opening brackets around ". $_ if $openingbracketfound==1;
		  $openingbracketfound=1;
	      }elsif ( $char eq ')' ){
		  return  "READ FAILURE: Multiple enclosing closing brackets around ". $_ if $openingbracketfound==0;
		  $openingbracketfound=0;
	      }elsif ($char eq '"'){
                  # We entered a 'character string'
		  # collect everything upto the closing quote
		  $buffer .= '"';
		  my $k=0;
		CHRSTR: while (s/(.)(.*)/$2/o){
		      $buffer .= $1;
		      $k++;
		      if ($k>256) {
			  print "Character strings should not be longer than 256 chars\n";
			  print "See RFC1035 section 3.3\n";
			  exit;
		      }
		      # Note that end of line will also terminate character 
		      # strings.
		      # This may not be RFC complient so we print a warning.
		      last CHRSTR if $1 eq '"';
		  }
		  print "WARNING: Unmatched quotes at end of line\n" if $buffer !~ /\"$/o;
	      }else{
		  # Single spaces between the tokens.. we depend on this later
		  if ($char=~/^\s+$/o){
		      $buffer.=" " unless $buffer=~/\s$/o;
		  }else{
		      $buffer.=$char;
		  }
	      }
	      $i++;
	      # Next line if we are at end of line and there is still a open bracket
	      # not matched.
	      next READLINE if $openingbracketfound && /^\s*$/o;
	  } # END LINEPARSE

	  # LINE HAS NOW BEEN PARSED.. ALL MULTILINES ARE ON ONE LINE AND
	  #
	  $buffer=~s/\s*$//go; # remove possible trailing spce
	  $_=$buffer;
	  $buffer='';
      }else{   # when not parsing the line char by char
	  s/\s+/ /go;   # Remove extra spaces
	  s/\s*$//go;   # Remove extra spaces
      }

      print "READLINE:>>".$_."<<\n" if DEBUG >2;

      if ( /^\s*\$TTL\s+(\d+)/o){   #FOUND a $TTL directive
	  $lastseenTTL=$1;
	  $defaultTTL=$lastseenTTL if (! $defaultTTL );
	  print ";; DEFAULT TTL found : ". $lastseenTTL ."\n" if DEBUG>1;
	  $self->{'default_ttl'}=$defaultTTL;
	  next READLINE;
      }

      # replace the @ by the ORIGIN.. as given by the argument.
      s/@/$lastseenORIGIN/;

      # Set the current originin. This is the one from the $ORIGIN value from 
      # the zone file. It will be used to complete dnames  below.
      if ( /^\s*\$ORIGIN\s+(\S+)\s*$/o){
	  $lastseenORIGIN=$1;
	  print ";; lastseenORIGIN set to : ". $lastseenORIGIN ."\n" if DEBUG>1;
	  next READLINE;
      }




      if ( /^\s*\$INCLUDE\s+(\S+)\s*(\S*)?$/io){
	  my $newfilename=$1;
	  $lastseenORIGIN=$2 if $2;
	  if ($newfilename=~/\//o){
	      # absolute pathname
	  }else{
	      #relative pathname
	      $newfilename=dirname($self->{'filename'})."/".$1;   # Relative path...
	  }

	  # Deep recursion is still possible....
	  return "READ FAILURE: Including $filename from itself would cause deep recursion\n" if ($filename eq $newfilename);
	  # Other recursion check

	  return "READ FAILURE: Nested INCLUDE more than 20 levels deep... \n".
	    "check if the  files are not including in loops..." if
	  $self->{"IncludeRecursionDetector"} > $MaxIncludeDepth;


	  # RFC 1035 section 5 specifies that the lastseenORIGIN does not traverse
	  # INCLUDES but is unclear on the last seen TTL. We use the lastseen TTL 
          # from the included file
	  $lastseenTTL=$self->_read($fh_out,$newfilename,$lastseenORIGIN,$previousdname,
		       $lastseenTTL);

	  return $lastseenTTL if $lastseenTTL =~ /^READ FAILURE:/o;
	  next READLINE;
      }

      # Use the previous dname if no dname was qualified (line starts with blanks)
      if (/^(\S+)\s+/o){
	  $previousdname=$1;
	  # below is a uggly bug fix. 
	  $previousdname=$lastseenORIGIN if ($previousdname eq '$GENERATE');
	  $previousdname=$lastseenORIGIN if ($previousdname eq '$INCLUDE');
      }else{
	  $_ = $previousdname . $_;
      }


      # $_ now either contains a GENERATE statement or a line with not
      # fully qualified domain names in both owner name as RDATA and
      # with possibly unqualified TTL and CLASS.

      if (
	  m{^\s*\$GENERATE       #Generate directive
	    	    \s+((\d+)-(\d+)(/(\d+))?)    #Range start-stop or start-stop/step.
	    	    \s+(\S+)               #The LHS
	    	    \s+(\S+)               #The TYPE
	    	    \s+(\S+)               #The RHS
	   	   }xo){
	  print  "Range: $2-$3 " if DEBUG;
	  print "/$5 " if DEBUG && $5;
	  print  "LHS: $6 "
		. "TYPE: $7 "
		  . "RHS: $8 \n" if DEBUG ;
	  my $RANGE=$1;
	  my $LOW=$2;
	  my $HIGH=$3;
	  my $STEP=$5?$5:1;
	  my $LHS=$6;
	  my $TYPE=$7;
	  my $RHS=$8;
	  if ($TYPE !~ /PTR|CNAME|DNAME|A|AAAA|NS/o)
	    {
		print "Generate only supports PTR, CNAME, DNAME, A, AAAA and NS.\n";
		next READLINE;
	    }
	  if ($LOW>$HIGH){
	      print "Range should be increasing.\n";
	      print "Skipping the following \$GENERATE directive:\n".$_;
	      next READLINE;
	  }
	  if ($LOW<0||$STEP<0){
	      print "Sorry all vallues in the range need to be positive";
	      print "Skipping the following \$GENERATE directive:\n".$_;
	      next READLINE;
	  }
	  my $i=$LOW;
	  while ($i<=$HIGH){

	      my $ownername =processGENERATEarg($LHS,$i,$lastseenORIGIN);

	      my $my_generated_record= $ownername ." ".$lastseenTTL." IN ".$TYPE." ";
	      if ($TYPE =~/CNAME|PTR|DNAME|NS/o){
		  # These types have expansion of the RDATA to FQDN
		  my $rdatastr= processGENERATEarg($RHS,$i,$lastseenORIGIN);
		  $my_generated_record .=   $rdatastr;
		  if (($TYPE =~/CNAME|DNAME/) && 
		      ($ownername eq $rdatastr) ){
		      $i+=$STEP;
		      next;
		  }
		  
	      }else{
		  # A and AAAA are left alone
		  $my_generated_record .=   processGENERATEarg($RHS,$i,"");
	      }
	      print ";; GENERATE: ". $my_generated_record ."\n" if DEBUG;

	      print $fh_out $my_generated_record ."\n";

	      if (defined $self->{"create_rr"}){
		  my $rr=Net::DNS::RR->new($my_generated_record);
		  
		  push @{$self->{"create_rr"}},$rr;
	      }
	      $i+=$STEP;
	  }


      }else{
	  my $returnval= $self->_parseline($_,$lastseenORIGIN,$lastseenTTL);
	  next READLINE if $returnval =~ /^__SKIPPED__$/o;
	  return $returnval if $returnval =~ /^READ FAILURE:/o;
	  $_ = $returnval;
	  print ";;    " . $_ . "\n"  if DEBUG>2;
      
	  print $fh_out $_ . "\n";
	  if (defined $self->{"create_rr"}){
	      my $rr=Net::DNS::RR->new($_);
	      push @{$self->{"create_rr"}},$rr;
	  }
      }
  }
    # Done parsing this file.
    $fh_in->close;
    $self->{"IncludeRecursionDetector"}--;
    print ";;   returning from _read\n"  if DEBUG>2;
    return $lastseenTTL;
}




####################################
#  Few access methods.
#  see perldoc for details

sub get_io {
    my $self=shift;
    return $self->{"fh"};
    }


sub get_array {
    my $self=shift;
    
    return [] unless    $self->{create_rr};
    return $self->{create_rr};
}


sub get_origin {
    my $self=shift;
    return $self->{'_origin'};
}




# 
# Internal functions.


#####################################
# complete_dname will append the origin to the input string if needed.
# Does a sanity check on escaped \.

sub _complete_dname
{
    my $self=shift;
    my $dname=shift;
    my $origin=shift;
    if ( $dname !~ /\.$/o && $dname !~ /\\\.$/o){       # Hmmmm what if a label ends in an escapped \. 

	$dname .= ".".$origin;
	# This fixes a bug, If the origin equals the root the above line
	# caused two trailing dots to be added.
	chop $dname if $origin eq ".";
    }


    return $dname;
}


####################################################
#  processGENERATEarg
#
# this function is used to expand lhs or rhs variables in 
# a generate statment.
# it takes the lhs or rhs string and and the current vallue of
# the itterator as input and returns the beast fully expanded according
# to the following rules.


#lhs describes the owner name of the resource records to be
#created. Any single $ symbols within the lhs side are replaced by the
#iterator value. To get a $ in the output you need to escape the $
#using a backslash \, e.g. \$. The $ may optionally be followed by
#modifiers which change the offset from the interator, field width and
#base. Modifiers are introduced by a { immediately following the $ as
#${offset[,width[,base]]}. e.g. ${-20,3,d} which subtracts 20 from the
#current value, prints the result as a decimal in a zero padded field
#of with 3. Available output forms are decimal (d), octal (o) and
#hexadecimal (x or X for uppercase). The default modifier is
#${0,0,d}. If the lhs is not absolute, the current $ORIGIN is appended
#to the name.



# See perldoc


sub processGENERATEarg {
    my $lhs=shift;
    my $i=shift;
    my $origin=shift;

    my $expanded="";
    while ($lhs) {
	my $remaining="";
	if ($lhs =~ s/^(\S*?)
	    	    ((?<!\\)\$.*)$               # The first non escaped $ character and anything beyond to end of sring
	    	    /$2/x){
	    $expanded.=$1 if $1;
	    $lhs=~ s/^\$(\{(\d+)(,(\d+))?(,(\w+))?\})?(.*)\s?$/$7/;
	    #	$lhs=~ s/\$//;
	    my $offset=$2?$2:0;
	    my $width=$4?$4:0;
	    my $format=$6?$6:"d";
	    if ($format !~ /d|o|x|X/o){
		die "Fatal error in parsing the format in a \$GENERATE statement.\n Should be d,o,x or X\n";
	    }
	    $expanded .= sprintf("%0$width$format",$i+$offset);
	}else{
	    $expanded.=$lhs;
	    $lhs="";

	}
    }
    $expanded =~s/\\\$/\$/og;  #finally substitute '$' for the escaped \$
    
    # Only expand to FQDN if the last char is a "." and if the
    # the $origin argument is not empty.

    $expanded .= ".". $origin if $expanded !~ /\.$/o && $origin ne "" ;

    return $expanded;
}


###################################
#
#  parseline will complete an inputline of the form <dname> [<TTL>]
#  [<CLASS>] <type> <RDATA> to a line with fully qualified names in
#  the dname and the RDATA, it will insert the CLASS and TTL if not
#  specified.  The arguments are the lastseenORIGIN and lastseenTTL
#  that are used to complete the domain names with, and to add to fill
#  in the unqualified TTLs.
#

# returns 0 on success
# returns string starting with "READ FAILURE:" on error.

# returns the string "__SKIPPED__" if a line was skipped (see the
# argumens to the read method such as STRIP_SEC &c).

sub _parseline {
    my $self=shift;
    $_=shift;
    my $lastseenORIGIN=shift;  # vallue of the last seen $ORIGIN directive
    my $lastseenTTL=shift;

    my $ttl;

    my $rtype='';
    my $rdata='';
    my $prefix='';

    ($_ =~ m/$ZONE_RR_REGEX/xso) || 
      return "READ FAILURE: \"".$_."\" did not match RR pattern.\nPlease clean your zonefile!\n";

    my $dname=$1;

    s/^\s*(\S+) / /o;  # remove the dname to put it back fully qualified
                      # If there is a match it could still be matching the
                      # string 0, so just testing on $1 will now work....
    if ( $1 || $1 eq "0" ) {
	$dname=$1;

	$dname=$self->_complete_dname($dname,$lastseenORIGIN);
	$_ = $dname . $_;
	print ";;    read DNAME: " . $dname ."\n" if  DEBUG>2 ;
    }else{
	return  "READ FAILURE: Couldn't match dname in read method while reading\n". $_ . " \nthis Should not happen\n";
    }



    # See if there is a TTL value, if not insert one
    if (/^\S+ (\d+)/o) {
	print ";;    TTL   : " . $1. "\n" if  $debug>2 ;
	$ttl=$1;
    }else {
		
	# RFC 1035
	# 'Omitted class and TTL values are default to the
	# last explicitly stated values"
	
	# I take that to mean last explicitly stated in a $TTL 
	# statement. (Purerely because of bind9 compatibility)
	
	# instert last seen TTL
	
	s/^(\S+) (.*)$/$1 $lastseenTTL $2/;
		
    }		


    # See if there is the CLASS is defined, if not insert one.
    if(! /^\S+ \d+ ($classes)/){   
	#insert IN
	s/^(\S+ \d+ )(.*)$/$1IN $2/o;
    }
    # We have everything specified.. We now get the RTYPE AND RDATA...
    /^\S+ \d+ ($classes) (\S+) (.*)$/;
    if ($1) {
	print ";;    rtype: " . $2 ."\n" if  DEBUG>2 ;
	$rtype=$2;
    }else{
	return "READ FAILURE: We expected to match an RTYPE\n". $_ . " \nthis Should not happen\n";
    }
    if ($3) {
	$rdata=$3;	       
	print ";;    rdata:-->" . $rdata ."<---\n" if  DEBUG>2 ;
	
    }else{
	return "READ FAILURE: We expected to find RDATA in the following record\n". $_ . " \ncheck your zonefile\n";
    }


    if (defined $ttl) {
	$prefix=$dname." ".$ttl." IN ".$rtype." ";
    }else{
	$prefix=$dname." ".$lastseenTTL." IN ".$rtype." ";
    }

    # Expand to FQDN in the RDATA.
    #
    # We apply a regular expression to the rdata and expand dnames in there
    # to fully qualified dnames using the complete_dname function.

    if ( uc $rtype eq "NS" ){
	#"NS"   		 RFC 1035, Section 3.3.11
	# the pattern below is appropriate if the rdata only contains a dname
	# or the dname is the last item in the RDATA string
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipping
	#	"MD"	RFC 1035, Section 3.3.4 (obsolete)
	#	"MF"  	RFC 1035, Section 3.3.5 (obsolete)
    } elsif ( uc $rtype eq "CNAME" ){
	#	"CNAME"  RFC 1035, Section 3.3.1
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
    }elsif ( uc $rtype eq "SOA" ){
	#	"SOA"	RFC 1035, Section 3.3.13	
	# first two strings in the SOA rdata are dnames
	$rdata=~/(\S+)\s+(\S+)\s+(\d+)\s+(.*)$/o;
	return  "READ FAILURE: Soa serial not found in\n $_\n" if ( ! $3 && $3 ne "0" );

	my $soaserial=$3;
	$soaserial++ if $self->{"bump_soa"};
	$_=$prefix.$self->_complete_dname($1,$lastseenORIGIN).
	  " " . $self->_complete_dname($2,$lastseenORIGIN).
	    " " .  $soaserial ." ". $4 ;      #
	
	# Additional sanity check.
	if ( lc($dname) ne lc($self->{'_origin'})){
	    print "WARNING: ORIGIN as specified or determined from the file name\n";
	    print "     does not match the SOA ownername. I'll be using the ownername!\n";
	    print "     origin set from ". $self->{'_origin'} ." to: ".$dname ."\n";
	    $self->{'_origin'}=$dname;
	}

    }elsif( uc $rtype eq "MB" ){		
	#	"MB"	RFC 1035, Section 3.3.3

	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
    }elsif( uc $rtype eq "PTR" ){
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
    }elsif( uc $rtype eq "MG"){
	#	"MG"	RFC 1035, Section 3.3.6
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
    }elsif( uc $rtype eq "MR"){
	#	"MR"	RFC 1035, Section 3.3.8
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipping 
	#	"NULL"	RFC 1035, Section 3.3.10
	#	"WKS"	RFC 1035, Section 3.4.2 (deprecated, and no dname)
    }elsif( uc $rtype eq "PTR"){
	#	"PTR"	RFC 1035, Section 3.3.12
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	#skipping
	#	"HINFO"	RFC 1035, Section 3.3.2 
    }elsif( uc $rtype eq "MINFO"){
	#	"MINFO"	RFC 1035, Section 3.3.7
	$rdata=~/(\S+) (\S+)$/o;
	$_=$prefix.$self->_complete_dname($1,$lastseenORIGIN).
	  " " . $self->_complete_dname($2,$lastseenORIGIN);
    }elsif( uc $rtype eq "MX"){
	#	"MX"	RFC 1035, Section 3.3.9
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipping
	#	"TXT"	RFC 1035, Section 3.3.14
    }elsif( uc $rtype eq "RP"){
	#	"RP"	RFC 1183, Section 2.2
	$rdata=~/(\S+) (\S+)$/o;
	$_=$prefix.$self->_complete_dname($1,$lastseenORIGIN).
	  " " . $self->_complete_dname($2,$lastseenORIGIN);
    }elsif( uc $rtype eq "AFSDB"){
	#	"AFSDB"	RFC 1183, Section 1
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipped
	#	"X25"	RFC 1183, Section 3.1
	#	"ISDN"	RFC 1183, Section 3.2
    }elsif( uc $rtype eq "RT"){
	#	"RT"	RFC 1183, Section 3.3
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipped
	#	"NSAP"	RFC 1706, Section 5
    }elsif(uc $rtype eq "SIG"){
	#	"SIG"	RFC 2555, Section 4.1
	return "__SKIPPED__" if $self->{'strip_old'};
	my ($typecovered, $algoritm,
            $type, $orgttl, $sigexpiration,
            $siginception, $keytag,$signame,$sig) = 
	      $rdata=~/^\s*(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(.*)/o;
	$_ = $prefix." $typecovered $algoritm $type $orgttl $sigexpiration $siginception $keytag ".
	  $self->_complete_dname($signame,$lastseenORIGIN)." $sig";

    }elsif(uc $rtype eq "PX"){
	#	"PX"	RFC 2163,
	my ($preference,$map822,$mapx400)= $rdata=~/(\d+) (\S+) (\S+)$/o;
	$_=$prefix." ".$preference." ".
	    $self->_complete_dname($map822,$lastseenORIGIN).
	    " ".
	    $self->_complete_dname($mapx400,$lastseenORIGIN);
    }elsif(uc $rtype eq "KEY"){
	# NOTHING
	
	# skipped
	#	"GPOS"	RFC 1712 (obsolete)
	#	"AAAA"	RFC 1886, Section 2.1
	#	"LOC"	RFC 1876
	
    }elsif( uc $rtype eq "NXT"){
	return "__SKIPPED__" if $self->{'strip_old'};
	#	"NXT"	RFC 2535
	$rdata=~/(\S+) (.*)$/o;
	$_=$prefix.$self->_complete_dname($1,$lastseenORIGIN).
	  " " . $2;
	
	
	#	"EID"   draft-ietf-nimrod-dns-xx.txt
	#	"NIMLOC"   draft-ietf-nimrod-dns-xx.txt
    }elsif( uc $rtype eq "SRV"){
	#	"SRV"	RFC 2782
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipped
	
	#	"ATMA"   [Dobrowski]
	# skipped... hmmmmm...

    }elsif( uc $rtype eq "NAPTR"){
	#	"NAPTR"	RFC 2168, 2915
	$rdata=~/(.*) (\S+)$/o;
	$_=$prefix.$1." ".$self->_complete_dname($2,$lastseenORIGIN);
    }elsif( uc $rtype eq "KX"){
	#	"KX"	RFC 2230
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	# skipped
	#	"CERT"	RFC 2358
	#	"A6"	RFC 2874
    }elsif( uc $rtype eq "DNAME"){
	#	"DNAME"	RFC 2672
	$_=$prefix.$self->_complete_dname($rdata,$lastseenORIGIN);
	
	#skipped
	#	"SINK"   [Eastlake]   # I don't know about this RR
	#	"OPT"	RFC 2671

	#       "APL"    RFC 3123   NO dname in RDATA
	#      "DS"          NO dname in RDATA
	#      "SSHFP        NO dname in RDATA
	
    }elsif( uc $rtype eq "NSEC"){
	#	"NSEC"
	return "__SKIPPED__" if $self->{'strip_nsec'};
	$rdata=~/(\S+) (.*)$/o;
	$_=$prefix.$self->_complete_dname($1,$lastseenORIGIN).
	  " " . $2;
    }elsif( uc $rtype eq "DNSKEY"){
	#	"DNSKEY"
	return "__SKIPPED__" if $self->{'strip_dnskey'};
	
    }elsif( uc $rtype eq "RRSIG"){
	#	"RRSIG"
	return "__SKIPPED__" if $self->{'strip_rrsig'};
        my ($typecovered, $algoritm,
            $type, $orgttl, $sigexpiration,
            $siginception, $keytag,$signame,$sig) = 
	      $rdata=~/^\s*(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(.*)/o;
	return "__SKIPPED__" if $self->{'strip_dnskey'} && uc($typecovered) eq "DNSKEY";
	return "__SKIPPED__" if $self->{'strip_nsec'} && uc($typecovered) eq "NSEC";
	return "__SKIPPED__" if $self->{'bump_soa'} && uc($typecovered) eq "SOA";
	$_ = $prefix." $typecovered $algoritm $type $orgttl $sigexpiration $siginception $keytag ".
	  $self->_complete_dname($signame,$lastseenORIGIN)." $sig";


	
    }elsif( uc $rtype=~/TYPE\d+/o){
	# Unknown RR.
    }

return $_;

}





# Use named-compilezone -D to do the processin;

sub _read_namedcomp{
    my  $self=shift;
    my $fh_out=shift;
    my $filename=shift;
    my $origin=shift;
    my $tmpfh = File::Temp->new();
    my $tmpfname = $tmpfh->filename;
    
    print ";; Tempfilename: $tmpfname\n" if $debug;

    print ";; _read_namedcomp: $filename $origin\n" if $debug;
    my $cmd="named-compilezone  -i none -o $tmpfname $origin $filename";
    print ";; Running: ".join(" ", $cmd)."\n" if $debug;

    my @result=`$cmd`; 
    if ($debug){
	    foreach my $i (@result){
		    print ";;; $i\n";
	    }
    }
    my $lastresult=pop( @result); 
    
   
    if ( $? == -1 ) { 
	    return "command failed: $!\n" 
    }elsif($lastresult =~/failed/){
	    return $lastresult;
    }

    
    open(DUMP,$tmpfname)|| return ("Could not execute ". join(" ", $cmd)) ;   # This should cause classic parsing
    my $loadzone_result="";


    $origin=~ s/\.$// unless ($origin eq ".") ;
    


    my $ProcessedApex;
    
  CONTENT: while (<DUMP>) {
	if (/^\S+\s+\d+\s+IN\s+(SOA|RRSIG\s+\w+|DNSKEY|NSEC|SOA|NXT|SIG)\s+/o){
	    my $type=$1;
	    $self->{strip_dnskey}&&  ($type eq "DNSKEY")&& next CONTENT;
	    # Also strip the sig over DNSKEY if we are stripping DNSKEYS
	    if ($type =~ /RRSIG\s+(\w+)/){
		$self->{strip_rrsig} && next CONTENT;
		$self->{strip_dnskey} && ($1 eq "DNSKEY") && next CONTENT;
		$self->{strip_nsec} && ($1 eq "NSEC") && next CONTENT;
		$self->{bump_soa} && ($1 eq "SOA") && next CONTENT;
	    }

	    $self->{strip_rrsig}&&  ($type eq "RRSIG")&& next CONTENT;
	    $self->{strip_nsec}&&  ($type eq "NSEC")&& next CONTENT;
	    $self->{strip_old} && 
		(($type eq "NXT") || ($type eq "SIG"))&& 
		next CONTENT;
	    if ($self->{bump_soa} && ($type eq "SOA")){
		my $soa=Net::DNS::RR->new($_);
		$soa->serial($soa->serial()+1);
		$_=$soa->string ."\n";  # The newline is FITAL, the next record
                                        # would otherwise disapear behind a 
                                        # comment.
	    }
	}
	
	print $fh_out $_;
	if (defined $self->{"create_rr"}){
	    my $rr=Net::DNS::RR->new($_);
	    push @{$self->{"create_rr"}},$rr;
	}
	
	
    }
    
    print $fh_out "\n"; # Make sure file ends with newline
    close(DUMP);
    return ("success");


}

sub DESTROY {

    close(DUMP);
}



1;





#