File Coverage

blib/lib/File/MkTempO.pm

Criterion	Covered	Total	%
statement	58	60	96.6
branch	10	20	50.0
condition	3	6	50.0
subroutine	12	12	100.0
pod	0	7	0.0
total	83	105	79.0

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

package File::MkTempO;

use vars qw($VERSION);

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

$File::MkTemp::VERSION = '1.0.6';

sub new {
  my $pkg = shift;

  croak("Usage: \$var = new File::MkTempO('templateXXXXXX',['dir']) ")
    unless(@_ == 1 || @_ == 2);

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

  my $me = bless {}, $pkg;
  $me->{'template'} = $_[0];
  $me->{'dir'} = $_[1] if @_ == 2;
  $me;
}

sub mktemp {
   my $me = shift;
   my ($template,$dir,$keepgen,$lookup);
   my (@template,@letters);

   $template = $me->{'template'};
   $dir = $me->{'dir'};

   @template = split //, $template;

   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)];
      }

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

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

   next if $keepgen == 0;

   }

   return($template);
}

sub mkstemp {

   my $me = shift;

   my $dir = $me->{'dir'};

   croak("You must specify a directory when creating the object in order to use mkstemp")
      unless $dir;

   my $template = $me->mktemp;

   my $openup = File::Spec->catfile($dir, $template);

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

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

   $me->{'fhtmpl'} = $template;
   $me->{'fhdirtmpl'} = $openup;

   return($fh);
}

sub template	{ my $me=shift; return $me->{'template'}; }
sub dir		{ my $me=shift; return $me->{'dir'}; }
sub fhtmpl	{ my $me=shift; return $me->{'fhtmpl'}; }
sub fhdirtmpl	{ my $me=shift; return $me->{'fhdirtmpl'}; }

1;

__END__