# Mktmp.pm
# Author: Noah Friedman <friedman@splode.com>
# Created: 2000-02-28
# Public domain.

# $Id: Mktmp.pm,v 1.1 2000/03/01 09:51:08 friedman Exp $

# Commentary:
# Code:

package NF::Mktmp;

use POSIX qw(:errno_h :fcntl_h);

use Symbol;
use strict;

use Exporter;
use vars qw($VERSION @ISA @EXPORT);
$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = qw(mktmp mktmpdir);



use vars qw($mktmp_dir);

$mktmp_dir = "/tmp";
my $mktmp_max = 5000;  # Grown dynamically as needed.


sub mktmp_random_file_name ($)
{
  my $prefix = shift;

  $prefix = join ("/", $mktmp_dir, $prefix)
    unless (index ($prefix, "/") >= $[);

  my $s = sprintf ("%%0%dd", length ("$mktmp_max"));
  my $n = sprintf ($s, int (rand ($mktmp_max)));
  return $prefix . $n;
}

sub mktmp_check_full ($)
{
  my $prefix = shift;
  $prefix = join ("/", $mktmp_dir, $prefix)
    unless (index ($prefix, "/") >= $[);

  my $dir = $prefix;
  $dir =~ s|/[^/]*$||o;

  my $b = $prefix;
  $b =~ s|.*/||o;
  my $re = join ('', '^', quotemeta ($b),
                 '\d' x length ("$mktmp_max"), '$');

  my $dfh = gensym;
  opendir ($dfh, $dir) || return undef;
  my @files = grep (/$re/, readdir ($dfh));
  closedir ($dfh);
  return scalar @files;
}

sub mktmp ($;$$)
{
  my ($prefix, $mode, $perm) = @_;
  my $fh = gensym;
  my $i = 0;

  $mode |= O_CREAT | O_EXCL;
  $perm ||= 0600;

  while (1)
    {
      my $file = mktmp_random_file_name ($prefix);

      return (wantarray ? ($fh, $file) : $fh)
        if (sysopen ($fh, $file, $mode, $perm));

      return undef if ($!+0 != EEXIST);

      # If the number of temporary files is very close to the maximum, it's
      # possible that we will loop more than $mktmp_max times before
      # finding a free file.  But regardless, double the mktmp_max size
      # so that we will continue to get fast results.
      if (++$i > $mktmp_max)
        {
          $i = 0;
          $mktmp_max *= 2;
        }
    }
}

sub mktmpdir ($;$)
{
  my ($prefix, $perm) = @_;
  my $i = 0;

  $perm ||= 0777;

  while (1)
    {
      my $dir = mktmp_random_file_name ($prefix);
      return $dir if (mkdir ($dir, $perm));
      return undef if ($!+0 != EEXIST);

      if (++$i > $mktmp_max)
        {
          $i = 0;
          $mktmp_max *= 2;
        }
    }
}

1;