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;