package Util::FileList;
##############################################################################
#
# DESCRIPTION: This class allows you to do a number of useful things with
# DESCRIPTION: a list of files.
# DESCRIPTION: Sub-classes such as Util::FITSlist and Util::EventFileList
# DESCRIPTION: add additional funtionality for specific types of files.
#
# HISTORY
# HISTORY: $Log: FileList.pm,v $
# HISTORY: Revision 1.3 2014/02/27 07:01:06 apsop
# HISTORY: VERSION header now shows CVS Revision
# HISTORY:
# HISTORY: Revision 1.2 2006/08/01 20:35:34 apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY:
#
# VERSION: $Revision: 1.3 $
#
##############################################################################
use Util::Tool;
use strict;
my $INVOCATION; # incremented each time new is called keeps file names unique
###############################################################################
# constructor
###############################################################################
sub new { #(file1, file2, file3 ...)
my $proto = shift;
my $class = ref($proto) || $proto;
my $self={};
@{$self->{FILES}}=@_;
####################################################
# increment counter each time an object is created
# so we can keep teporary file names unique
####################################################
$INVOCATION++;
$self->{TMP_FILE_SUFFIX}="_${INVOCATION}.tmp";
$self->{LIST_FILE}="file_list".$self->{TMP_FILE_SUFFIX};
###################################################
# maximum line length for in-lining the files in
# an FTOOL parameter
###################################################
$self->{MAX_PARAM_LENGTH}=80;
bless($self,$class);
return $self;
} # end of constructor
##################################
# ACCESSORS:
##################################
############################################################################
# append a file to the end of the list
############################################################################
sub add {
my $self = shift;
my $file = shift;
push @{$self->{FILES}}, ($file);
} # end of add method
#################################################
# returns an array containing all the file names
#################################################
sub files {
my $self=shift;
return (@{$self->{FILES}});
}
#################################################
# returns the number of files in the list
#################################################
sub count {
my $self=shift;
my $count = @{$self->{FILES}};
return $count;
}
###################################################
# returns the name of the index-th file in the list
###################################################
sub file {
my $self=shift;
my $index=shift;
if(! defined $index ) {$index=0}
return ${$self->{FILES}}[$index];
}
##########################################################################
# returns the names of all the files in a form suitable for
# use in an FTOOL parameter.
# See the "as_param" method.
# Note this is the same as the "files" method
# but it is separate to allow subclasses to override it
##########################################################################
sub files_for_param {
my $self=shift;
return ($self->files());
}
##########################################################################
# get or set the name of the unique suffix used for temporary file names
##########################################################################
sub tmp_file_suffix {
my $self=shift;
if(@_) { $self->{TMP_FILE_SUFFIX}=shift}
return $self->{TMP_FILE_SUFFIX};
}
###############
# METHODS:
###############
#############################################################################
#############################################################################
# Give the list of files in a form suitable for use as an input parameter
# to an FTOOL. First tries to format the files as a space-separated
# list. If the length of this string is longer than $self->{MAX_PARAM_LENGTH}
# it dumps the file names to an ascii file and returns the name of that
# file preceeded by "@". This is a standard FTOOL convention.
# The temporary file is deleted when this object is destroyed, so
# it will generally be necessary to explicitly call the DESTROY method
# to force the list file to stick around long enough to be used.
#############################################################################
sub as_param {
my $self=shift;
my $value=join ' ', $self->files_for_param();
if(length($value) <= $self->{MAX_PARAM_LENGTH} ) {
###############################################
# file list is short enough to fit on one line
###############################################
return $value;
} else {
##############################################
# too many files - we have to dump the list
# to a temporary file
##############################################
open LIST, ">$self->{LIST_FILE}";
print LIST join "\n", $self->files_for_param();
print LIST "\n"; # FTOOLS need this
close LIST;
return "\@$self->{LIST_FILE}";
}
} # end of as_param method
#############################################################################
#############################################################################
# merge all the files in the list into a single file
# 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.
# This method simply concatenates the files. Subclasses override this method.
#############################################################################
sub merge {
my $self=shift;
my $merged=shift;
if(@{$self->{FILES}} == 1 ) {
####################################################
# only one file so just give the name of that file
####################################################
return $self->file();
}
##################################
# concatenate the files
##################################
unlink $merged;
open MERGED, ">$merged";
my $file;
foreach $file ($self->files()) {
open IN, "<$file";
print MERGED <IN>;
close IN;
}
close MERGED;
#####################################
# return the name of the merged file
#####################################
return $merged;
}
#############################################################################
#############################################################################
# create a new list which is a subset of this one.
# The arguments are the index of the first and last files in the list.
# The index of the first file is zero.
# - If $to is beyond the end of the list, it is reduced to the end of the list
# - If $from is beyond the end of the list or $from >$to, undef is returned.
# - If $from==0 and $to is at or beyond the end of the list, a reference
# to this same object is returned.
#############################################################################
sub sublist {
my $self=shift;
my $from=shift;
my $to=shift;
my $nfiles=@{$self->{FILES}};
#########################################
# handle special cases
#########################################
if($to >= $nfiles) {$to= $nfiles-1 }
if($from >= $nfiles or $to<$from ) {return undef }
if($from==0 && $to==$nfiles-1) {return $self}
#########################################
# create and return a sub-list
#########################################
return $self->new(@{$self->{FILES}}[$from..$to]);
} # end of sublist method
#############################################################################
#############################################################################
# delete all the files in the list.
# If a log object and an message string are given, that message will be
# logged if any files are removed.
#############################################################################
sub delete {
my $self=shift;
my $log=shift;
my $message=shift;
my @files=$self->files();
if($log && $message && @files) {
$log->entry($message);
$log->text(join("\n", @files)) ;
}
foreach (@files ) {
unlink;
}
} # end of delete method
#############################################################################
#############################################################################
# make a tar file containing all the files in the list
#############################################################################
sub tar {
my $self=shift;
my $tarfile=shift;
Util::Tool->new("system","tar")
->command_line("-cvf $tarfile",$self->files() )
->run();
return $self;
} #end of tar method
#############################################################################
#############################################################################
# destructor - deletes temporary file list. This method should probably be
# called explicitly after using the as_param method
#############################################################################
sub DESTROY {
my $self=shift;
unlink $self->{LIST_FILE};
}
1;