Util::FITSfile (version 1.9)


package Util::FITSfile;
##############################################################################
#
# DESCRIPTION: This class is used for operating on a single FITS file. 
# DESCRIPTION: For the most part it is an interface to the "futils" FTOOLS.
#
# HISTORY
# HISTORY: $Log: FITSfile.pm,v $
# HISTORY: Revision 1.2  2006/08/01 20:35:34  apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2000-06-19
# HISTORY: added stats method
# HISTORY: 
# HISTORY: 1.1 -> 1.2 2000-07-06
# HISTORY: Added interface to fmodhead. Also now dump column names to a 
# HISTORY: temporary file if the list is too long for a parameter value.
# HISTORY: 
# HISTORY: 1.2 -> 1.3 2000-07-18
# HISTORY: Modified table method to handle the care where the file has
# HISTORY: only one row and the rows are specified as "-". In this case we
# HISTORY: have to explicitly set the row number to "1", since ftabpar
# HISTORY: doesn't understand "-".
# HISTORY: 
# HISTORY: 1.3 -> 1.4 2000-08-15
# HISTORY: added import_header method
# HISTORY: 
# HISTORY: 1.4 -> 1.5 2001-03-20
# HISTORY: Modified site_independant_checksum to be more robust.
# HISTORY: Now removed HISTORY and COMMENT keywords and inline comments.
# HISTORY: 
# HISTORY: 1.5 -> 1.6 2003-03-17
# HISTORY: Added append_to method
# HISTORY: 
# HISTORY: 1.6 -> 1.7 2003-10-10
# HISTORY: Fixed some stderr output when calling the rows method on a
# HISTORY: corrupted FITS file
# HISTORY: 
# HISTORY: 1.7 -> 1.8 2004-05-04 
# HISTORY: Added "keywords" method which returns all
# HISTORY: keywordas as a hash. This method should be used with caution as it
# HISTORY: may be removed in the future.
# HISTORY: 
# HISTORY: 1.8 -> 1.9 2004-05-26
# HISTORY: Added list_hdus method
#
# VERSION: 1.9
#
##############################################################################

use Util::Ftool;
use Util::HEAdas;
use strict;

my $CHECKSUM_TOOL="";

my $INVOCATION; 

###############################################################################
# If the extension, "ext", is omitted, it defaults to "1".
# The primary HDU is "0".
# Note that ext can be either numerical or symbolic - i.e. it may refer
# to the EXTNAME keyword of the desired extension. Don't use
# brackets around the extension name argument.
# Specifications are optional FITSIO file selection specifications.
# These do need to include all punctuation, such as brackets. 
# See the FITSIO extended filename syntax documentation for more information.
###############################################################################
sub new { #(filename, ext, specifications)
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self={};

    $self->{NAME} =shift;
    $self->{EXT}  =shift;
    $self->{SPECS}=shift || "";

    ############################################
    # stuff to keep temporary file names unique
    ############################################
    $INVOCATION++;
    my $temp_suffix="_$self->{NAME}_$INVOCATION.tmp";

    #################################
    # default to the first extension
    #################################
    if( ! defined($self->{EXT}) ) {$self->{EXT}=1};

    $self->{COLS}="-"; # these default to all rows and columns
    $self->{ROWS}="-"; 
    $self->{DUMP_SEPARATOR}=" "; # field separator for fdumps

    $self->{MANY_KEYWORDS}=0; #flag for using fmodhead or not.
    $self->{FMODHEAD_TEMPLATE}="fmodhead_template$temp_suffix";

    $self->{COLUMN_FILE}="fits_columns$temp_suffix";
    $self->{MAX_COL_CHARACTERS}=80;


    bless($self,$class);
    return $self;


}

##################################
# ACCESSORS:
##################################

######################################################
# get or set the name of the file without decorations
######################################################
sub name {
    my $self = shift;
    if (@_) { $self->{NAME} = shift }
    return $self->{NAME};
}

######################################################
# get or set the FITS extension
######################################################
sub ext {
    my $self = shift;
    if (@_) { $self->{EXT} = shift }
    return $self->{EXT};
}

######################################################
# get or set the file specifiers.
######################################################
sub specs {
     my $self = shift;
    if (@_) { $self->{SPECS} = shift }
    return $self->{SPECS};
}

##############################################################################
##############################################################################
# Sets the current column specifier which is handed off to most FTOOLS
# verbatim. This is a space separated list of column names, though sometimes
# only a single column name is appropriate. Multiple arguments
# will be concatenated.
# If there are too many columns to fit on a single parameter line, this method
# will dump them to a temporary file
##############################################################################
sub cols { 
    my $self = shift;
    $self->{COLS} = join ' ', @_;

    ##################################################################
    # check if we have too many columns to fit on one parameter line
    ##################################################################
    if( length($self->{COLS}) > $self->{MAX_COL_CHARACTERS} ) {
        ###################################
        # need to dump columns into a file
        ###################################
        open  LIST, ">$self->{COLUMN_FILE}";
        foreach (split /\s/, $self->{COLS} ) {
            print LIST "$_\n";
        }

        $self->{COLS}="\@$self->{COLUMN_FILE}";
    }




    return $self;
}


##########################################################################
# set the row specifier which is handed verbatim to most FTOOLS. 
# By convention it can consist of a comma-separated list of
# single numbers or ranges specified as two numbers separated by a "-".
# However, note that sometimes only a single number is appropriate.
#########################################################################
sub rows {
    my $self = shift;
    $self->{ROWS} = shift;
    return $self;
}

##########################################################################
# set the character used as a field separator in fdump. You probably don't
# need to worry about this unless you have a table with a string column
# containing a "|" character
##########################################################################
sub dump_separator {
    my $self = shift;
    $self->{DUMP_SEPARATOR} = shift;
    return $self;
}

###########################################################################
# return the current fdump field separator. See above.
###########################################################################
sub get_dump_separator {
    my $self = shift;
    return $self->{DUMP_SEPARATOR};
}



###########################################################################
# return the file name will all extended filename syntax decorations
# attached.
###########################################################################
sub fullname {
    my $self=shift;

    return "$self->{NAME}\[$self->{EXT}\]" . $self->{SPECS};

}
###########################################################################
# Get or set the Util::Tool object in the class data which will be
# used to calculate site-independant checksums.
###########################################################################
sub checksum_tool {
    my $self = shift;
    if (@_) { 
        ########################################
        # set the checksum program
        ########################################
        my $path=shift;
        my $command;
        ($path,$command)= $path =~ /(.*)\/(.*)/;
        $CHECKSUM_TOOL = Util::Tool->new($path,$command)
                                   ->verbose(0);

    }

    ###############################################
    # reset the input to nothing before returning
    ###############################################
    $CHECKSUM_TOOL->stdin("")
                  ->command_line("");

    return $CHECKSUM_TOOL;
}

#################
# METHODS:
#################


####################################################
# return the number of columns currently specified.
# If no columns are specified, 
# it returns the total number of columns in the table.
####################################################
sub ncols {
    my $self=shift;

    if($self->{COLS} eq "-") {
        ##########################################
        # all the columns are currently specified
        # so we need to read the tfields keyword
        ##########################################
        return $self->keyword("TFIELDS");
    } else {
        ###################################
        # count the number of columns
        ###################################
        unless( $self->{COLS} =~ /^@/ ) {
            #####################################
            # the columns are listed explicitly
            #####################################
            return split /\s/, $self->{COLS};
        } else {
            ###################################
            # the columns are listed in a file
            ###################################
            open LIST, "<$self->{COLUMN_FILE}";
            my @cols=<LIST>;
            close LIST;
            return @cols;
       
        }
    }

} # end of ncols method


####################################################
# return the number of rows currently specified.
# If no rows are specified, 
# it returns the total number of rows in the table.
####################################################
sub nrows {
    my $self=shift;
    
    ###############################################
    # parse the number of rows from the specifier
    ###############################################
    my $nrows=0;
    foreach (split /\s*,\s*/, $self->{ROWS} ) {

        if( /-/ ) {
            #############################################
            # specifier contains a dash, meaning a range
            #############################################
            my ($from,$to) = /([^-]*)-([^-]*)/;

            ######################################
            # if values are left out they default 
            # to the ends of the file
            ######################################
            if(!defined $from || $from eq "" ) { $from=1 }
            if(!defined $to   || $to   eq "" ) {$to=$self->keyword("NAXIS2") }
            
            ##############################################
            # if we couldn't read the NAXIS2 keyword,
            # $to will still be undefined. In this case
            # we return zero rows for this file
            ##############################################
            if(!defined $to || $to eq "" ) {return 0 }

            ######################################################
            # add the number of rows in this segment to the total
            ######################################################
            $nrows += $to - $from +1;

        } else {
            #################################
            # specifier is a single number
            #################################
            $nrows++;
        }
    } # end of loop over specifier segments

    return $nrows;

} # end of nrows method
     

#############################################################################
# returns the total number of HDUs in the FITS file
#############################################################################
sub nhdus {
    my $self=shift;

    my $fstruct = Util::Ftool->new("fstruct")
                             ->verbose(0)
                             ->params({infile  => $self->{NAME},
                                       outfile => "STDOUT"        });

    $fstruct->run();
    my $nhdus = $fstruct->parfile()->read("totalhdu");

    return $nhdus;

} 

#############################################################################
# returns a list of all the HDUs in the FITS file
#############################################################################
sub list_hdus {
    my $self = shift;
    
    ###############################################
    # use "ftlist to get a summary of the file 
    ###############################################
    my $ftlist = Util::HEAdas->new("ftlist")
                             ->verbose(0)
                             ->params({infile=>$self->{NAME},
                                       option=>"H",
                                       outfile=>"-",
                                       clobber=>"no",
                                       include=>"",
                                       exclude=>"",
                                       section=>":",
                                       columns=>"",
                                       rows=>"",
                                       vector=>"",
                                       separator=>"|",
                                       rownum=>"no",
                                       colheader=>"no"});
    $ftlist->run();
    
    ############################################################
    # parse the ftlist output to get a list of extension names
    ############################################################
    my @lines = split /^/m, $ftlist->stdout();

    my @extensions=();
    foreach my $line (@lines) {
        chomp($line);
        
        my @fields = split /\s+/, $line;
        
        ####################################
        # skip the header
        ####################################
        if(! @fields || $fields[0] ne "HDU" ) { next; }

        push @extensions, $fields[2];
    }
    
    return (@extensions);



} # end of list_hdus method
              
#############################################################################
# returns the number corresponding to a given column name or 0 if the column
# is not contained in the file
#############################################################################
sub find_column {
    my $self = shift;
    my $col = shift;

    #############################################################
    # loop over columns until we find the one we are looking for
    #############################################################
    my $ncols=$self->keyword("TFIELDS");
    unless(defined $ncols) { return 0; }

    my $i;
    for($i=1; $i<=$ncols; $i++) {

        if($self->keyword("TTYPE${i}") eq $col ) { return $i }
    }

    ############################################
    # if we get here, we didn't find the column
    ############################################
    return 0;

} # end of find_column method
    


#############################################################################
#############################################################################
# Dump the contents of a table into a single long string. This is
# really just an interface to the fdump FTOOL. This low level access method
# is mostly for internal use. Most table access should be done with the
# "table" method.
#############################################################################
sub dump_table {
    my $self=shift;

    #################################
    # dump the file 
    #################################
    my $cols = $self->{COLS};
    $cols =~ s/ /,/g;
    my $fdump=Util::HEAdas->new("ftlist")
                         ->params({infile    => $self->fullname(),
                                   outfile   => "-",
                                   columns   => $cols,
                                   "rows"    => $self->{ROWS},
                                   separator => $self->{DUMP_SEPARATOR},
				   option    => 'T',
				   colheader => 'no',
                                   rownum    => 'no',
                                   clobber   => 'no'})
                         ->verbose(0)
                         ->run();

    ########################################
    # trim leading and trailing blank lines
    ########################################
    $fdump->{STDOUT} =~ s/^[\s\n]*//; 
    $fdump->{STDOUT} =~ s/[\s\n]*$//; 

    return $fdump->{STDOUT};

}

#############################################################################
#############################################################################
# Returns the currently specified rows and columns of the table.
# If only one column and row are specified, it returns that value -
# either as a scalar or as an array with a single value, depending on the 
# context.
# If more than one row or column are specified, returns the values in a
# a single array cycling fastest over rows.
# Note that with two columns this can be convenient if you want to put
# the values into a hash.
# For three or more columns you may need to do some awkward reshuffling.
#############################################################################
sub table {
    my $self=shift;

    ################################################
    # get the number of columns currently specified
    ################################################
    my $ncols = $self->ncols();

    if($ncols == 1 ) {
        #################################################
        # only one column, The default " " dump_separator
        # will work best here - that way whitespace
        # is trimmed automaitcally by fdump
        #################################################
        unless( $self->nrows() == 1 ) {
            ###################################################
            # dump multiple rows of a single column
            # the default " " field separator is best here
            # since with it, fdump automatically trims 
            # whitespace from string columns
            ###################################################
            return (split /\s*\n\s*/, $self->dump_table()   );

        } else {
            ###########################################################
            # we only need a single value, so use ftabpar
            # note we have to be careful of the case where the table
            # only has one row.
            ###########################################################
            my $row=$self->{ROWS};
            if($row eq '-' ) { $row=1 }
            my $reader=Util::Ftool->new("ftabpar")
                                  ->params({fitsfile => $self->fullname(),
                                            column   => $self->{COLS},
                                            row      => $row,
                                            element  => 1, })
                                  ->run();

            my $value;
            if($reader->parfile()->read("undef") eq "no") {
                $value= $reader->parfile()->read("value");
            } 

            if(wantarray() ) { return ($value); }
            else             { return $value; }


        } # end if we only want one row and column


    } elsif($ncols >1 ) {
        ####################################################
        # multiple columns, by default use "|" as the field
        # separator
        ####################################################
        my $sep=$self->get_dump_separator();
        if( $sep =~ /^\s*$/ ) {
            ###############################
            # spaces generally won't cut it
            ################################
            $sep="|";
            $self->dump_separator($sep);
        }

	return  ( split /\s*[\n\|]\s*/, $self->dump_table() );

    } else {
        ###########################
        # no columns
        ###########################
        return undef;
    }

} # end of dump_column method

        
######################################################################
# Check if the current column is in order.
# - returns 1 if the column is in order
# - returns 0 if the column is not in order or if there is an error from 
#             cktime
# The default column name is "TIME" if none is explicitly specified.
#
# An empty table is considered to be ordered.
######################################################################
sub isOrdered {
    my $self=shift;
    my $unique=shift || "";

    ###################################
    # make sure the table is not empty
    # cktime gives an error if it is
    ###################################
    unless($self->keyword("NAXIS2")) { return 1; }


    #####################################
    # get the columns name
    #####################################
    my $col=$self->{COLS};
    if($col eq "" || $col eq "-" ) { $col="TIME" }

    #####################################
    # checkequal parameter based on 
    # the "unique" argument
    #####################################
    my $ckequal;
    if($unique) {$ckequal="yes"}
    else        {$ckequal="no" }


    #########################################
    # set up and run the cktime FTOOL
    #########################################
    my $cktime=Util::Ftool->new("cktime")
                          ->params({infile =>$self->fullname(),
                                    colname=>$col,
                                    ckequal=>$ckequal})
                          ->run();

    #######################################
    # parse the output and return the
    # appropriate value
    #######################################
    my $stdout=$cktime->stdout();

    if($stdout =~ /Same time as previous/ ||
       $stdout =~ /Out of time order/       ) { return 0 }
    else                                      { return 1 }

}

########################################################################
########################################################################
# sort a table by the current column(s).
# The default column is "TIME" if none is explicitly specified.
########################################################################
sub sort {
    my $self=shift;

    my $col=$self->{COLS};
    if($col eq "" || $col eq "-" ) { $col="TIME" }

    ####################################
    # defaults
    ####################################
    my $ascend="yes";
    my $method="insert";
    my $unique="no";

    ########################################
    # interpret options
    ########################################
    my $arg;
    while($arg=shift) {
        if($arg eq "reverse") {$ascend="no"}  # sort in decending order
        if($arg eq "unique")  {$unique="yes"} # delete rows with same key

        if($arg eq "insert" ||                
           $arg eq "heap"   ||                # sort algorithms
           $arg eq "shell"    ) {$method=$arg}
    }

    ####################################
    # filename
    ####################################
    my $full=$self->fullname();
    my $file=$self->name();

    ###########################################
    # run fmemsort
    ###########################################
    Util::Ftool->new("fmemsort")
               ->params({infile   => $full,
                         outfile  => "!$file",
                         columns  => $col,
                         method   => $method,
                         ascend   => $ascend,
                         load2mem => "yes",
                         copyprime=> "yes",
                         copyall  => "yes",
                         unique   => $unique,
                         history  => "yes"})
               ->run();

    #####################################################
    # reset filttering specifications to null since
    # they will be automatically fulfilled in the new
    # version of this file
    #####################################################
    $self->{SPECS}="";

    return $self;

} # end of sort method



############################################################################
# Read or set a keyword value from the header
# - If one argument is given, read the keyword of that name.
# - If two or more arguments are given, write the value in the second 
#   argument to the keyword and return a reference to this object.
# - If three arguments are given, the third is the inline keyword comment.
############################################################################
sub keyword {
    my $self=shift;
    my $key=shift;
    my $value=shift;
    my $comment=shift || " ";
    
    unless( defined $value ) {
        ###############################
        # read the keyword value
        ###############################
        my $fkeypar=Util::HEAdas->new("ftkeypar")
                                ->params({infile=>$self->fullname(),
                                         keyword =>$key});
	$fkeypar->seriousness(0);
	$fkeypar->run();
    
        my $exists=$fkeypar->parfile()->read("exist");
        if($exists eq "yes") {
            #######################################
            # keyword exists so return its value
            #######################################
            my $value=$fkeypar->parfile()->read("value");

            #############################
            # trim quotes and whitespace
            #############################
            $value =~ s/^'//;
            $value =~ s/'$//;

            $value =~ s/^\s*//;
            $value =~ s/\s*$//;

            return $value;
        } else {
            ########################
            # keyword does not exist
            ########################
            return undef;
        }


    } else {
        ##############################
        # we need to write a keyword
        ##############################
        unless($self->{MANY_KEYWORDS}) {
            ########################################
            # just add this keyword using fparkey
            #######################################
            Util::HEAdas->new("fthedit")
                       ->params({value    => $value,
                                 infile   => $self->fullname(),
                                 keyword  => $key,
                                 comment  => $comment,
                                 operation=> 'add'})
                       ->run();
        } else {
            ############################################################
            # this is just one of a long string of keywords which will
            # be added with fmodhead
            ############################################################
            if( $value =~ /\s/ ) { $value="'$value'" }
            open  TEMPLATE, ">>$self->{FMODHEAD_TEMPLATE}";
            print TEMPLATE "${key}=$value / $comment\n";
            close TEMPLATE;
        }

        return $self;

    } # end of we are writing a keyword



} # end of keyword method

############################################################################
############################################################################
# begin a long set of keywords to add using fmodhead instead of fparkey
# The keywords themselves are specified using the keyword method.
############################################################################
sub begin_many_keywords {
    my $self=shift;

    $self->{MANY_KEYWORDS}=1;

    unlink $self->{FMODHEAD_TEMPLATE};

    return $self;
}

############################################################################
############################################################################
# End a long list of keyword modifications and apply those modifications to the
# file. See the begin_many_keywords method.
############################################################################
sub end_many_keywords {
    my $self=shift;

    Util::HEAdas->new("fthedit")
               ->params({infile  => $self->fullname(),
                         keyword => '@'.$self->{FMODHEAD_TEMPLATE} })
               ->run();

    $self->{MANY_KEYWORDS}=0;
    unlink $self->{FMODHEAD_TEMPLATE};
}

############################################################################
############################################################################
# Get a hash of all the keywords in an HDU
############################################################################
sub keywords {
  my $self=shift;

  #################################
  # dump the file 
  #################################
  my $fdump=Util::HEAdas->new("ftlist")
                       ->params({infile   => $self->fullname(),
				 outfile  => "STDOUT",
				 option   => 'K',
				 separator=> ' ',
				 clobber  => 'no'})
                         ->verbose(0)
                         ->run();

  ##############################
  # trim leading blank lines
  ##############################
  $fdump->{STDOUT} =~ s/^[\s\n]*//; 

  #######################################################
  # Clean out history, comment and end keywords, mostly
  # because they don't have equal signs
  #######################################################
  $fdump->{STDOUT} =~ s/^(COMMENT|HISTORY|END)[^\n]*\n//;

  my %hash;
  foreach ( split "\n", $fdump->{STDOUT} ){
    if( /^([\w-]+)\s*=\s*'(.+)'/ ){
      $hash{$1} = $2;
      $hash{$1} =~ s/ +$//;
    }elsif( /^([\w-]+)\s*=\s*([^\s\/]+)/ ){
      $hash{$1} = $2;
    }
  }

  return %hash;
}


############################################################################
############################################################################
# copy the header from another file into this one, optionally omitting
# all the listed keywords.
############################################################################
sub import_header { #(source, [except|include], key1, key2...)
    my $self=shift;
    my $source=shift;
    my @keys=@_;

    ######################################################
    # do we want to include or omit the listed keywords?
    ######################################################
    my $except="";
    if($keys[0] eq "except" ) {
        $except=shift @keys;
    }

    if($keys[0] eq "include" ) {
        shift @keys;
    }

    #############################
    # should we copy comments?
    #############################
    my $comment="yes";
    if($except && @keys != (@keys = grep {$_ ne  "COMMENT"} @keys ) ||
                  @keys != (@keys = grep {$_ ne "!COMMENT"} @keys ) ) {
        $comment="no";
    }

    ##################################
    # should we copy HISTORY records?
    ##################################
    my $history="yes";
    if($except && @keys != (@keys = grep {$_ ne  "HISTORY"} @keys ) ||
                  @keys != (@keys = grep {$_ ne "!HISTORY"} @keys ) ) {
        $history="no";
    }

    ##################################
    # should we copy scale records?
    ##################################
    my $scale="yes";
    if($except && @keys != (@keys = grep {$_ ne  "scale"} @keys ) ||
                  @keys != (@keys = grep {$_ ne "!scale"} @keys ) ) {
        $scale="no";
    }

    ###################################
    # edit the key list if we need to 
    ###################################
    if($except) {
        foreach (@keys) {
            if(!/^!/) { $_ = "!$_" }
        }
    }

    #########################################
    # print the key list to a temporary file
    #########################################
    my $keyword_list="import_header_keyword_list.tmp";
    open  LIST, ">$keyword_list";
    print LIST join "\n", @keys;
    close LIST;
        


    ################################
    # run the cphead FTOOL
    ################################
    Util::Ftool->new("cphead")
               ->params({infile=>$source,
                         outfile=>$self->fullname(),
                         keyfil=>$keyword_list,
                         scale=>$scale,
                         comment=>$comment,
                         history=>$history})
               ->run();

    unlink $keyword_list;

    return $self;

} # end of import_header method





############################################################################
############################################################################
# Modify the in-line comment for the current column of a FITS table.
# Note that the current columns must be set to a single column name.
############################################################################
sub column_comment {
    my $self=shift;
    my $comment=shift;

    ################################
    # get the column number
    ################################
    my $fcolpar=Util::Ftool->new("fcolpar")
                           ->params({infile  => $self->fullname(),
                                     colname => $self->{COLS},
                                     exact   => "yes"})
                           ->run();

    if($fcolpar->had_error() ) { return }

    my $column_number=$fcolpar->parfile()->read("colnum");
    my $key="TTYPE$column_number";

    ###############################################
    # set the comment, and keep the value the same
    ###############################################
    $self->keyword($key,$self->{COLS},$comment);

} # end of column_comment method



############################################################################
# This method generates a site-independant checksum for a FITS file.
# It does this by dumping the headers of the file,
# deleting keywords such as DATE, ORIGIN, and CHECKSUM,
# and generating a checksum of that. Note that if FITS data checksums
# have been generated, this takes the data parts of the file into account.
############################################################################
sub site_independant_checksum {
    my $self=shift;

    #################################
    # dump the file 
    #################################
    my $fdump=Util::Ftool->new("fdump")
                         ->params({infile   =>$self->name(),
                                   outfile  =>"STDOUT",
                                   "rows"   =>"-",
                                   columns  =>"-",
                                   prhead   =>"yes",
                                   prdata   =>"no",
                                   showcol  =>"no",
                                   showunit =>"no",
                                   showscale=>"yes",
                                   showrow  =>"no",
                                   page     =>"no",
                                   wrap     =>"no",
                                   align    =>"no",
                                   xdisp    =>"b",
                                   pagewidth=>"256"})
                         ->verbose(0)
                         ->run();


    ###########################################
    # remove certain keywords
    ###########################################
    $fdump->{STDOUT} =~ s/^\s*$//gm; 
    $fdump->{STDOUT} =~ s/^DATE    .*$//gm;
    $fdump->{STDOUT} =~ s/^ORIGIN  .*$//gm; 
    $fdump->{STDOUT} =~ s/^CHECKSUM.*$//gm;
    $fdump->{STDOUT} =~ s/^HISTORY .*$//gm;
    $fdump->{STDOUT} =~ s/^COMMENT .*$//gm;

    ###############################
    # remove inline comments
    ###############################
    $fdump->{STDOUT} =~ s/''//g;
    $fdump->{STDOUT} =~ s/(^........= '[^']*').*$/$1/gm;  # string values
    $fdump->{STDOUT} =~ s/(^........= \s*[^'][^\s]*).*$/$1/gm; # non-string

    #########################################
    # remove extraneous white space
    #########################################
    $fdump->{STDOUT} =~ s/\s*$//gm; # clip off white space at end of line
    $fdump->{STDOUT} =~ s/\n{2,}/\n/g; # remove empty lines

    my $sum=$self->checksum_tool();
    $sum->stdin($fdump->{STDOUT})
        ->run();

    my $answer;
    ($answer)= $sum->stdout() =~ /(\S*)/;

    return $answer;
}
    
    

#############################################################################
#############################################################################
# Run fcopy to copy this FITS file to another. This is mostly useful 
# if you want to use the extended file name syntax to filter a file.
# If no filename is given,  fcopy will overwrite the input file, effectively
# screening in place.
#############################################################################
sub copy {
    my $self=shift;
    my $newfile=shift;
    
    if( ! defined $newfile) { $newfile="!".$self->name() }

    Util::HEAdas->new("ftcopy")
                ->params({infile => $self->fullname(),
                          outfile => $newfile     })
                ->run();

    if($newfile eq "!".$self->name() ) {
        ##############################################################
        # we're overwritting this file, so 
        # reset the filtering specifications to null
        # since those are automatically met by the new file
        # and specifying them would force reading the file to memory
        # in any subsequent FTOOLS calls
        #############################################################
        $self->{SPECS}="";

    } 

    return $self;

} # end of copy method

#############################################################################
#############################################################################
# This is similar to the copy method, except that it only copies the current
# HDU of the FITS file. It is basicly a wrapper aourn fextract.
#############################################################################
sub extract {
    my $self=shift;
    my $newfile=shift;
    
    if( ! defined $newfile) { $newfile="!".$self->name() }

    Util::Ftool->new("fextract")
               ->params({infile => $self->fullname(),
                        outfile => $newfile,    
                        clobber => "yes" })
               ->run();

    if($newfile eq "!".$self->name() ) {
        ##############################################################
        # we're overwritting this file, so 
        # reset the filtering specifications to null
        # since those are automatically met by the new file
        # and specifying them would force reading the file to memory
        # in any subsequent FTOOLS calls
        #############################################################
        $self->{SPECS}="";

    } 

    return $self;

} # end of extract method


#############################################################################
#############################################################################
# append the current extension to another FITS file using "fappend".
#############################################################################
sub append_to {
    my $self = shift;
    my $file = shift;
    
    Util::HEAdas->new("ftappend")
                ->params({infile  => $self->fullname(),
                          outfile => $file,
                          history => "no"})
                ->run();

} # end of append_to method




#############################################################################
#############################################################################
# run fverify on the file. Don't report anything unless there is an error.
# Returns 1 if there was an error, and 0 otherwise.
#############################################################################
sub verify {
    my $self=shift;

    my $log=Util::Ftool->log();

    ##################################################
    # set up and run the fverify tool
    ##################################################
    my $fverify=Util::HEAdas->new("ftverify")
                            ->params({infile   => $self->fullname(),
                                      outfile  => "STDOUT",
                                      prhead   => "no",
                                      testdata => "yes"})
                            ->verbose(0)
                            ->run();

    if($fverify->had_error() || $fverify->parfile()->read("numerrs")) {
        #################################################
        # only dump the fverify output if there was an
        # error to avoid filling up the log with trash
        # note we set fverify to not be verbose above
        #################################################
        $log->entry("output from fverify");
        $log->text($fverify->stdout() );
        
        return 1;
    }

    ############################
    # no error if we got here
    ############################
    return 0;

} # end of verify method

    
###########################################################################
###########################################################################
# Calculate statistics for the current row and column.
# The statistics are calculated using the fstatistic FTOOL and are returned
# as an array: ($sum,$mean,$sigma,$min,$max).
###########################################################################
sub stats {
    my $self=shift;

    my $tool=Util::Ftool->new("fstatistic") 
                        ->params({infile  => $self->fullname(),
                                  colname => $self->{COLS},
                                  "rows"  => $self->{ROWS},
                                  outfile => "STDOUT",
                                  maxval  => "INDEF",
                                  minval  => "INDEF"})
                       ->verbose(0)
                       ->run();

    my $parfile=$tool->parfile();
    
    my $sum=$parfile->read("sum");
    my $mean=$parfile->read("mean");
    my $sigma=$parfile->read("sigma");
    my $min = $parfile->read("min");
    my $max = $parfile->read("max");
 
    $tool->DESTROY;

    return ($sum,$mean,$sigma,$min,$max);

} #end of stats method


############################################################################
############################################################################
# clean up temporary files
############################################################################
sub DESTROY {
    my $self=shift;

    unlink $self->{FMODHEAD_TEMPLATE};
    unlink $self->{COLUMN_FILE};

} # end of destructor method 

    
1;