# Id: Temp.pm,v 1.3 1997/08/16 02:43:42 reece Exp

##############################################################################
## Nothing to modify beyond this line
##############################################################################

=head1 NAME

Temp -- flexible temporary filename generation for perl

S<Id: Temp.pm,v 1.3 1997/08/16 02:43:42 reece Exp>

=head1 SYNOPSIS

use File::Temp;

use File::Temp qw(newtmpfn deletetmpfiles);

=item

$tmpfn=C<newtmpfn>(prefix,tmpdir,suffix);

generate a new file name

=item

C<deletetmpfiles>();

delete all issued filenames if such files exist

=item

C<%File::Temp::issued>

hash of all issued filenames

=back

=head1 DESCRIPTION

newtmpfn() generates the full path filename for a temporary file.  The
prefix of the file is 'tmp' unless specfied.  The file will be in the
specified directory, $TMPDIR, or /tmp.  A suffix will be added if
specified.  All arguments are optional.  If a file name is returned, it
will be unique, never before issued in this process, and creatable;
otherwise; undef will be returned and $! set to the error.

deletetmpfiles() removes all issued files if they exist.

=head1 INSTALLATION

Put this file in your perl lib directory (usually
/usr/local/perl5/lib) or one of the directories in $PERL5LIB.

=head1 LICENSE

This source code is hereby released to the public domain and is unsupported.
You are encouraged to copy and modify this file.  Please clearly document
modifications with authorship and motivation.  Bug reports, code
contributions, and suggestions are appreciated.

=head1 SOURCE

New versions of this file may be obtained from (as of 1998/11/08)
  * http://www.in-machina.com/~reece/src/File/Temp.pm
  * ftp://in-machina.com/pub/reece/src/File/Temp.pm

=head1 AUTHOR

S<Reece Kimball Hart, http://www.in-machina.com/~reece/         >

=cut

##############################################################################
## Nothing to modify beyond this line
##############################################################################

package File::Temp;

use Carp;
use strict;
require 5.001;
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $RCSId $jemappelle);
@ISA = qw(Exporter);
@EXPORT = qw(newtmpfn deletetmpfiles);
@EXPORT_OK = qw(newtmpfn deletetmpfiles);

$RCSId = 'Id: Temp.pm,v 1.3 1997/08/16 02:43:42 reece Exp ';
$RCSId =~ s/\$//g; $RCSId =~ s/\s+$//;
$jemappelle='File::Temp';                   # what's my name?

my(%issued)=();                             # hash of issued filenames

                                            # Are these errno's portable?
my($ENOTDIR)=20;                            # not a directory [ENOTDIR]
my($ENOTWRITABLE)=13;                       # permission denied [EACCES]
my($ENOTREADABLE)=13;                       # permission denied [EACCES]

sub newtmpfn
  {
  my($prefix,$tmpdir,$suffix) = @_;
  my($filename)=undef;
  my($serial);

  $prefix = "tmp-$$-" if not defined($prefix);
  $tmpdir=$ENV{'TMPDIR'} if not defined($tmpdir);
  $tmpdir="/tmp" if not defined($tmpdir);
  $suffix='' if not defined($suffix);
  ( -d $tmpdir ) || do {$!=$ENOTDIR; return undef};
  ( -w $tmpdir ) || do {$!=$ENOTWRITABLE; return undef};
  ( -x $tmpdir ) || do {$!=$ENOTREADABLE; return undef};
  
  # The following is serial seach from a random number
  # The goal is to obviate serial search from a hard wired number (slow
  # when many files are needed and over distributed filesystems), and to
  # guarantee an eventual result (which a random number might not do).
  for( $serial=int(rand(999999))
       ; ( (not defined $filename)          # first time through loop
           or (defined $issued{$filename}   # name already issued
               or -e $filename) )           # file axists
       ; $serial++ )
    {
    $filename=sprintf("$tmpdir/$prefix%06d$suffix",$serial);
    }
  $issued{$filename}++;
  return($filename);
  }


sub deletetmpfiles
  {
  my($file);
  foreach $file (keys %issued)
    {
    if ( not unlink($file) and -e $file)    # can't unlink and it exists?
      {
      warn($jemappelle,': ',$file,': ',$!,"\n");
      next;
      }
    }
  }

1;

__END__
# perl -mFile::Temp -e 'File::Temp::Test()'
sub Test
  {
  my($n)=10;
  my($i);
  my($fn);
  $SIG{'INT'}=sub {warn "\n$File::Temp::jemappelle: caught ^C interrupt... cleaning up\n";
				   deletetmpfiles(); die "\n"};
  srand($$);
  print "$0: generating $n files...";
  for($i=1; $i<=$n; $i++)
	{
	$fn=newtmpfn();
	die("$!") if not defined $fn;
	print(STDERR $fn,"\n");
	open(F,">$fn"); print(F $fn, "\n", $$, "\n"); close(F);
	}
  print "done.\n";

  print "$0: removing $n files...";
  deletetmpfiles();
  print "done.\n";
  }

1;