package Util::FITSlist;
##############################################################################
#
# DESCRIPTION: This class handles a list of FITS files. In particular it
# DESCRIPTION: provides an interface to the ffilecat and fmerge FTOOLs.
# DESCRIPTION: The Util::EventFileList sub-class does even more specific things
# DESCRIPTION: for FITS event files.
#
# HISTORY
# HISTORY: $Log: FITSlist.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-07-05
# HISTORY: Reduced the maximum number of input files for ffilecat from
# HISTORY: 999 to 998 to compensate for a possible bug in that FTOOL.
# HISTORY:
# HISTORY: 1.1 -> 1.2 2000-08-08
# HISTORY: Added max_keyword, unique_keywords, and get_extension methods
# HISTORY: Now the select method will return the same type of object as
# HISTORY: is calling the method to facilitate inheritance.
# HISTORY:
# HISTORY: 1.2 -> 1.3 2003-03-18
# HISTORY: Modified select method to do a better job of parsing the keyword
# HISTORY: names from the expression. Previously non-A-Z characters were
# HISTORY: treated as spaces.
# HISTORY:
# HISTORY: 1.3 -> 1.4 2003-05-06
# HISTORY: Modified so that each FITS file can have a different extension.
#
# VERSION: 1.4
#
##############################################################################
use Util::FileList;
use Util::Ftool;
@ISA=("Util::FileList");
use strict;
###############################################################################
# This is not much different from the inherited constructor. It also
# sets the extension specifier to undef and initializes some internal
# things needed for cataloging.
###############################################################################
sub new {
my $self=shift;
#####################################
# inherit generic list initialization
#####################################
$self=$self->SUPER::new(@_);
$self->{EXT}=[];
########################################################
# maximum number of files which can be fed to ffilecat
# at one time
########################################################
$self->{MAX_FFILECAT}=998;
$self->{CATALOG}="fits_list_catalog".$self->tmp_file_suffix();
$self->{CATALOG_KEYS}={};
return $self;
} # end of constructor
##################################
# ACCESSORS:
##################################
########################################################
# add a file to the end of the list.
########################################################
sub add {
my $self = shift;
my $file = shift;
my $ext = shift;
$self->SUPER::add($file);
push @{$self->{EXT}}, ($ext);
$self->{CATALOG_KEYS} = {};
}
########################################################
# return the file names without the extension specifier
########################################################
sub files {
my $self=shift;
return (@{$self->{FILES}});
}
########################################################
# return the file names with the extension specifier
########################################################
sub files_with_ext {
my $self=shift;
my @with_ext=();
for(my $i=0; $i<$self->count(); $i++) {
my $file = ${$self->{FILES}}[$i];
my $ext = ${$self->{EXT} }[$i];
if(defined $ext) { push @with_ext, ("$file\[$ext\]"); }
else { push @with_ext, ($file); }
}
return (@with_ext);
}
################################################################
# return the index-th file name without the extension specifier
################################################################
sub file {
my $self=shift;
my $index=shift;
if(! defined $index ) {$index=0}
return ${$self->{FILES}}[$index];
}
################################################################
# return the index-th file name with the extension specifier
################################################################
sub file_with_ext {
my $self=shift;
my $index=shift;
if(! defined $index ) {$index=0}
return ${$self->files_with_ext()}[$index];
}
################################################################
# This overrides the inherited method to return the files names
# with the extension specifier.
################################################################
sub files_for_param {
my $self=shift;
return ($self->files_with_ext());
}
####################################################################
####################################################################
# set the extension indicator in all the file names.
# Giving no argument will leave off the extension indicator.
####################################################################
sub extension {
my $self=shift;
my $ext = shift;
for(my $i=0; $i<$self->count(); $i++) {
${$self->{EXT}}[$i] = $ext;
}
return $self;
}
####################################################################
####################################################################
# set separate extensions for each file. The arguments are a list of
# extensions in the same order as the files
####################################################################
sub extensions {
my $self=shift;
@{$self->{EXT}} = @_;
return $self;
}
#############################################################################
#############################################################################
# return the extension of the first file
#############################################################################
sub get_extension {
my $self=shift;
return ${$self->{EXT}}[0];
}
#############################################################################
#############################################################################
# return the list of all extensions
#############################################################################
sub get_extensions {
my $self=shift;
return (@{$self->{EXT}});
}
########################
# METHODS:
########################
#############################################################################
#############################################################################
# Merge all the files in the list into a single file using the fmerge FTOOL
# and return the name of the merged file.
# If the list contains only one file this method does nothing and returns
# the name of that one file.
# The second argument is the name of the EXTNAME of the merged file.
# Any additional agruments is a list of columns to be merged.
#
# Note this overrides the inherited method, which just concatenates the files.
#############################################################################
sub merge {
my $self=shift;
my $merged=shift;
my $ext=shift || " ";
if(@{$self->{FILES}} == 1 ) {
####################################################
# only one file so just give the name of that file
####################################################
return @{$self->{FILES}}[0];
}
unlink $merged;
my $fmerge = Util::Ftool->new("fmerge")
->params({infiles => $self->as_param(),
outfile => $merged,
mextname => $ext,
copyprime => "yes",
lastkey => " ",
history => "no",
clobber => "yes" });
$fmerge->params({columns => join(' ', @_)}) if @_;
$fmerge->run();
return $merged;
}
#############################################################################
#############################################################################
# Create a new list which is a subset of the total.
# This method is identical to the inherited method ,
# except that it also sets the extension in the new list to be the same as in
# this one.
#############################################################################
sub sublist {
my $self=shift;
my $from=shift;
my $to=shift;
###############################################
# inherit the geric list method
###############################################
my $new_list=$self->SUPER::sublist($from,$to);
if($new_list && $new_list != $self) {
######################################################
# created a new list, so set the extension
######################################################
my @extensions = $self->get_extensions();
@extensions = @extensions[$from...$to];
$new_list->extensions(@extensions);
}
#############################
# return the result
#############################
return $new_list;
} # end of sublist method
#############################################################################
#############################################################################
# make a FITS catalog file out of the list
#############################################################################
sub catalog { #(catalog, key1, key2...)
my $self=shift;
my $catalog=shift;
my @keys=@_;
#######################################
# set up the ffilecat FTOOL
#######################################
my $ffilecat=Util::Ftool->new("ffilecat")
->params({outfile => $catalog,
keywords => join(' ', @keys),
maxlen => 20,
minlen => 0,
aform => "NONE",
eform => "NONE",
iform => "NONE",
omit => "yes",
quiet => "no" });
unlink $catalog;
#######################################################################
# ffilecat can only handle so many files at one time
# but if an existing file is given for the output file
# it will append to that file.
# so we loop over sub-lists until we have cataloged the whole thing.
######################################################################
my $list;
my $from;
for($from=0;
$list = $self->sublist($from, $from+$self->{MAX_FFILECAT}-1);
$from += $self->{MAX_FFILECAT} ) {
#####################################
# make or append to the catalog
#####################################
$ffilecat->params({infile=>$list->as_param()})
->run();
}
} # end of catalog method
#############################################################################
#############################################################################
# make a temporary FITS catalog file for internal use.
# If we have already made a catalog containing the requested keywords,
# no new catalog will be created.
# The temporary catalog file will be deleted when the FITSlist object is
# destroyed.
#############################################################################
sub temp_catalog { #(key1, key2...)
my $self=shift;
my @keys=@_;
###################################################
# have we already made a catalog with these keys?
###################################################
my $match=1;
my $key;
foreach $key (@keys) {
$match &&= exists($self->{CATALOG_KEYS}->{$key});
}
if($match) {return}
###########################################################
# we don't already have a catalog which will do the trick
# first record the list of new keys
###########################################################
$self->{CATALOG_KEYS}={};
foreach $key (@keys) {
$self->{CATALOG_KEYS}->{$key}=1;
}
#####################################
# now create the catalog file
#####################################
$self->catalog($self->{CATALOG},@keys);
return $self;
} # end of temp_catalog method
#############################################################################
#############################################################################
# Return arrays of keyword values for all the files in the list.
# The arrays are returned in the same way as UTIL::FITSfile->table().
# Specifying "FILENAME" as one of the columns will give the corresponding file
# names.
#############################################################################
sub keywords { #(key1, key2...)
my $self=shift;
my @cols=@_;
my @keys = grep $_ ne "FILENAME", @cols;
if(@cols && !@keys ) {
#############################################
# only the filename was requested, so just use the
# files method
###################################################
return ($self->files());
}
##############################################
# first make sure we have a catalog with the
# requested keywords in it
##############################################
$self->temp_catalog(@keys);
##############################################
# now dump the catalog
##############################################
return (Util::FITSfile->new($self->{CATALOG})
->cols(@cols)
->table() );
} # end of keywords method;
#############################################################################
#############################################################################
# find the maximum value of a given keyword
# In scalar context returns the maximum keyword value.
# In list context returns the name of the first file with the maximum value
# and the maximum value.
#############################################################################
sub max_keyword {
my $self=shift;
my $key=shift;
my %value=$self->keywords("FILENAME", $key);
my @files=keys %value;
my $max=shift @files;
foreach (@files) {
if($value{$_} > $value{$max} ) { $max = $_ }
}
if(wantarray() ) {
return($max, $value{$max} );
} else {
return $value{$max};
}
} # end of max_keyword method
#############################################################################
#############################################################################
# find the minimum value of a given keyword
# In scalar context returns the minimum keyword value.
# In list context returns the name of the first file with the minimum value
# and the minimum value.
#############################################################################
sub min_keyword {
my $self=shift;
my $key=shift;
my %value=$self->keywords("FILENAME", $key);
my @files=keys %value;
my $min=shift @files;
foreach (@files) {
if($value{$_} < $value{$min} ) { $min = $_ }
}
if(wantarray() ) {
return($min, $value{$min} );
} else {
return $value{$min};
}
} # end of min_keyword method
#############################################################################
#############################################################################
# sum the values of a given keyword
#############################################################################
sub sum_keywords {
my $self=shift;
my $key=shift;
my $sum=0.;
foreach ($self->keywords($key) ) {
$sum += $_;
}
return $sum;
} # end of sum_keywords method
#############################################################################
#############################################################################
# return a list of the unique values of a given keyword.
# i.e. repeated values are dropped.
#############################################################################
sub unique_keywords {
my $self=shift;
my $key=shift;
my %unique=();
foreach ($self->keywords($key) ) {
$unique{$_}=1;
}
return keys %unique ;
} # end of unique_keywords method
#############################################################################
#############################################################################
# Create a new file list which gives a subset of this list
# and which is selected according to an expression involving the
# header keywords.
#############################################################################
sub select {
my $self=shift;
my $expression=shift;
##################################################
# parse the expression to get a list of keywords
##################################################
my $text = $expression;
$text =~ s/[0-9]+\.?[eE][+-]?[0-9]+//; # remove scientific notation numbers
my @keys = $text =~ /([A-Z][A-Z0-9_-]{0,7})/g;
my %uniq=();
foreach (@keys) { $uniq{$_} = 1; }
@keys = keys %uniq;
####################################################
# make a temporary catalog file containing the
# required keywords
####################################################
$self->temp_catalog(@keys);
##############################################################
# dump the catalog with the selection criteria applied
##############################################################
my @files = Util::FITSfile->new($self->{CATALOG}, 1, "\[$expression\]")
->cols("FILENAME")
->table();
#####################################################
# remove any extension specifiers from the filenames
#####################################################
my @extensions=();
foreach (@files) {
push @extensions, (/\[(.*)\]$/);
s/\[.*\]$//g;
}
############################################################
# return a reference to a new FITSlist which contains
# only the selected files
############################################################
return $self->new(@files)
->extensions(@extensions);
} # end of select method
#############################################################################
#############################################################################
# Returns another file list sorted by the given set of keywords.
#############################################################################
sub sort { #(key1, key2...)
my $self=shift;
my @keys=@_;
################################
# sort in reverse order?
################################
my $reverse;
if(@keys[@keys-1] eq "reverse" ) {
$reverse = pop @keys;
}
############################
# create temporary catalog
############################
$self->temp_catalog(@keys);
#############################
# sort the catalog
#############################
my @sorted=Util::FITSfile->new($self->{CATALOG}, 1)
->cols(@keys)
->sort($reverse)
->cols("FILENAME")
->table();
#####################################################
# remove any extension specifiers from the filenames
#####################################################
my @extensions=();
foreach (@sorted) {
push @extensions, (/\[(.*)\]$/);
s/\[.*\]$//g;
}
#############################################
# return a new list with the sorted files
#############################################
return Util::FITSlist->new(@sorted)
->extensions(@extensions);
} # end of sort method
#############################################################################
#############################################################################
# destructor - deletes temporary file list and catalog.
# This method should probably be
# called explicitly after using the as_param method.
#############################################################################
sub DESTROY {
my $self=shift;
$self->SUPER::DESTROY();
unlink $self->{CATALOG};
}
1;