Util::FileList (version 1.0)


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.2  2006/08/01 20:35:34  apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY:
#
# VERSION: 1.0
#
##############################################################################

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;