File Coverage

blib/lib/File/MkTemp.pm

Criterion	Covered	Total	%
statement	50	53	94.3
branch	13	24	54.1
condition	10	15	66.6
subroutine	8	8	100.0
pod	0	3	0.0
total	81	103	78.6

#############################################################
# File/MkTemp.pm. Written in 1999|2000 by Travis Gummels.
# If you find problems with this please let me know.
# [e-mail]
#############################################################

package File::MkTemp;

require Exporter;

use strict;

use vars qw($VERSION @ISA @EXPORT);

use FileHandle;
use File::Spec;
use Carp;

@ISA=qw(Exporter);
@EXPORT=qw(mktemp mkstemp mkstempt);

$VERSION = '1.0.6';

sub mkstempt {
   my ($template,$openup,$fh);
   my @retval;

   croak("Usage: mkstempt('templateXXXXXX','dir',['ext']) ")
      unless(@_ == 2 || @_ == 3);

   $template = mktemp(@_);

   $openup = File::Spec->catfile($_[1], $template);

   $fh = new FileHandle ">$openup";  #and say ahhh.

   croak("Could not open file: $openup")
      unless(defined $fh);

   @retval = ($fh,$template);

   return(@retval);
}

sub mkstemp {
   my ($template,$openup,$fh);

   croak("Usage: mkstemp('templateXXXXXX','dir',['ext']) ")
      unless(@_ == 2 || @_ == 3);

   $template = mktemp(@_);

   $openup = File::Spec->catfile($_[1], $template);

   $fh = new FileHandle ">$openup";  #and say ahhh.

   croak("Could not open file: $openup")
      unless(defined $fh);

   return($fh);
}

sub mktemp {
   my ($template,$dir,$ext,$keepgen,$lookup);
   my (@template,@letters);

   croak("Usage: mktemp('templateXXXXXX',['/dir'],['ext']) ")
     unless(@_ == 1 || @_ == 2 || @_ == 3);

   ($template,$dir,$ext) = @_;
   @template = split //, $template;

   croak("The template must end with at least 6 uppercase letter X")
      if (substr($template, -6, 6) ne 'XXXXXX');

   if ($dir){
      croak("The directory in which you wish to test for duplicates, $dir, does not exist") unless (-e $dir);
   }

   @letters = split(//,"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ");

   $keepgen = 1;

   while ($keepgen){
      for (my $i = $#template; $i >= 0 && ($template[$i] eq 'X'); $i--){
         $template[$i] = $letters[int(rand 52)];
      }

      undef $template;

      $template = pack "a" x @template, @template;

      $template = $template . $ext if ($ext);

         if ($dir){
            $lookup = File::Spec->catfile($dir, $template);
            $keepgen = 0 unless (-e $lookup);
         }else{
            $keepgen = 0;
         }

   next if $keepgen == 0;
   }

   return($template);
}
1;

__END__