# -*-Perl-*- 
# 
# TempFiles  - Allocate and manage temporary files.
# 
#
# Typical construction:
# 
#   my $tfiles=TempFiles->new();       <-- Initialise package use default directory. prefix, etc..
# 
#   END { $tfiles->destroyTemp if defined $tfiles; }      <-- Trash all temp files upon any exit.
#
#
# Typical usage:
# 
#   my $cafile = $tfiles->getTemp(-prefix => 'caf');    <-- $cafile gets set to something like /tmp/caf0_17348
#
#
# $Id: TempFiles.pm,v 1.4 1997/04/24 13:06:52 dn1 Exp $
#
# $Log: TempFiles.pm,v $
# Revision 1.4  1997/04/24  13:06:52  dn1
# Added copyright
#
# Revision 1.3  1996/07/25  12:53:18  sd
# Incorrect advice in Typical construction comment!
#
# Revision 1.2  1996/04/01  15:24:48  dmh
# AdCan now overide all defaults in &getTemp
#
# Revision 1.1  1996/04/01  15:00:07  dmh
# Initial revision
#
#
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

package TempFiles;

##########################################
#
# Construct...
#
##########################################

sub new { 

    my $type=shift;

    my $self={};
    $type->setDefaults($self);

    my %args = @_;
    foreach (keys%args) {
        $self->{$_} = $args{$_};
    }

    @{$self->{'temp_files'}} = ();

    bless $self, $type;

}

sub setDefaults {

    my ($type, $param_ref)=@_;

    $param_ref->{'dir'} = '/tmp/';         # Directory to write files
    $param_ref->{'prefix'} = '_TempFiles'; # All temp files will carry this prefix
    $param_ref->{'suffix'} = "_$$";        # Process id suffix for uniqueness
    $param_ref->{'file_count'} = 0;        # Allocation count
}


##########################################
#
# Methods
#
##########################################


############################################################
# $temp_file_name=&getTemp;
#
# Allocate and register temp file name.
#
# Facilitates for temp file deletion on error.
#
############################################################

sub getTemp {

    my $type = shift;
    my %args = @_;

    my $dir = $args{'-dir'} || $type->{'dir'};
    my $prefix = $args{'-prefix'} || $type->{'prefix'};
    my $suffix = $args{'-suffix'} || $type->{'suffix'};
    my $count = $type->{'file_count'};

    my $new_temp_filename="$dir$prefix$count$suffix";

    $type->{'file_count'}++;
    push(@{$type->{'temp_files'}}, $new_temp_filename);

    $new_temp_filename;
}



############################################################
# destroyTemp($file)
#
# Deletes temporary file(s).
#
# If no args, *all* temp files are removed
#
############################################################

sub destroyTemp {

    my $type = shift;
    my(@to_delete)=@_;

    if ($#to_delete==-1) {
        if (defined(@{$type->{'temp_files'}})) {
            # Delete all temporary files listed in @{$type->{'temp_files'}}
            foreach (@{$type->{'temp_files'}}) {
                if (-e $_) { # Not all allocated files get wriiten to.
                    unlink("$_") || warn "\nWARNING: Unable to remove temporary file: \"$_\"$!\n";
                }
            }
            undef(@{$type->{'temp_files'}});
        }
    } else {
	my $file;
        foreach $file (@to_delete) {
            if (-e "$file") {
                unlink("$file") || warn "\nWARNING: Unable to remove temporary file: \"$_\"$!\n";
            }
            for($i=0;$i<=$#{$type->{'temp_files'}};$i++) {
                if (${$type->{'temp_files'}}[$i] eq $file) {
                    splice(@{$type->{'temp_files'}},$i,1);
                    $i--;
                }
            }
        }
    }
}



1;
