Resync with mainline prior to post-5.6.0 updates

p4raw-id: //depot/vmsperl@6111

10 files changed, 1666 insertions, 65 deletions

diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm
index 8a8afac05f..667e7cb883 100644
--- a/lib/File/Compare.pm
+++ b/lib/File/Compare.pm
@@ -78,7 +78,7 @@ sub compare {
     }
     else {
 	unless (defined($size) && $size > 0) {
-	    $size = $fromsize;
+	    $size = $fromsize || -s TO || 0;
 	    $size = 1024 if $size < 512;
 	    $size = $Too_Big if $size > $Too_Big;
 	}
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 22a8ab3aed..ac73f1b5eb 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -349,7 +349,7 @@ sub _find_opt {
 
         unless ($Is_Dir) {
 	    unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
-		($dir,$_) = ('.', $top_item);
+		($dir,$_) = ('./', $top_item);
 	    }
 
             $abs_dir = $dir;
@@ -370,9 +370,9 @@ sub _find_opt {
                 warn "Couldn't chdir $abs_dir: $!\n";
                 next Proc_Top_Item;
             }
-            
-            $name = $abs_dir;
-            
+
+            $name = $abs_dir . $_;
+
             &$wanted_callback;
 
         }
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index 40f5345140..ed26d76a56 100644
--- a/lib/File/Spec.pm
+++ b/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '0.8';
+$VERSION = '0.81';
 
 my %module = (MacOS   => 'Mac',
 	      MSWin32 => 'Win32',
diff --git a/lib/File/Spec/Functions.pm b/lib/File/Spec/Functions.pm
index 140738f443..0036ac1ded 100644
--- a/lib/File/Spec/Functions.pm
+++ b/lib/File/Spec/Functions.pm
@@ -3,7 +3,9 @@ package File::Spec::Functions;
 use File::Spec;
 use strict;
 
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+
+$VERSION = '1.1';
 
 require Exporter;
 
diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm
index 959e33d0cf..5315d9220f 100644
--- a/lib/File/Spec/Mac.pm
+++ b/lib/File/Spec/Mac.pm
@@ -1,8 +1,11 @@
 package File::Spec::Mac;
 
 use strict;
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
+
+$VERSION = '1.1';
+
 @ISA = qw(File::Spec::Unix);
 
 =head1 NAME
@@ -79,9 +82,9 @@ sub catdir {
     shift;
     my @args = @_;
     my $result = shift @args;
-    $result =~ s/:\z//;
+    $result =~ s/:\Z(?!\n)//;
     foreach (@args) {
-	s/:\z//;
+	s/:\Z(?!\n)//;
 	s/^://s;
 	$result .= ":$_";
     }
@@ -150,7 +153,7 @@ sub rootdir {
     require Mac::Files;
     my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
 					 &Mac::Files::kSystemFolderType);
-    $system =~ s/:.*\z/:/s;
+    $system =~ s/:.*\Z(?!\n)/:/s;
     return $system;
 }
 
@@ -228,7 +231,7 @@ sub splitpath {
     my ($volume,$directory,$file) = ('','','');
 
     if ( $nofile ) {
-        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\z))?)(.*)@s;
+        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
     }
     else {
         $path =~ 
@@ -242,8 +245,8 @@ sub splitpath {
     }
 
     # Make sure non-empty volumes and directories end in ':'
-    $volume    .= ':' if $volume    =~ m@[^:]\z@ ;
-    $directory .= ':' if $directory =~ m@[^:]\z@ ;
+    $volume    .= ':' if $volume    =~ m@[^:]\Z(?!\n)@ ;
+    $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
     return ($volume,$directory,$file);
 }
 
@@ -259,7 +262,7 @@ sub splitdir {
     # check to be sure that there will not be any before handling the
     # simple case.
     #
-    if ( $directories !~ m@:\z@ ) {
+    if ( $directories !~ m@:\Z(?!\n)@ ) {
         return split( m@:@, $directories );
     }
     else {
@@ -286,11 +289,11 @@ sub catpath {
 
     my $segment ;
     for $segment ( @_ ) {
-        if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) {
+        if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
             $result .= "/$segment" ;
         }
-        elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) {
-            $result  =~ s@/+\z@/@;
+        elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
+            $result  =~ s@/+\Z(?!\n)@/@;
             $segment =~ s@^/+@@s;
             $result  .= "$segment" ;
         }
diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm
index 33370f06c1..20bf8c9dce 100644
--- a/lib/File/Spec/OS2.pm
+++ b/lib/File/Spec/OS2.pm
@@ -1,8 +1,11 @@
 package File::Spec::OS2;
 
 use strict;
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
+
+$VERSION = '1.1';
+
 @ISA = qw(File::Spec::Unix);
 
 sub devnull {
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 0cbc8c7e57..6ca26d74ce 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -1,6 +1,9 @@
 package File::Spec::Unix;
 
 use strict;
+use vars qw($VERSION);
+
+$VERSION = '1.1';
 
 use Cwd;
 
@@ -35,7 +38,7 @@ sub canonpath {
     $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
-    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
+    $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
     return $path;
 }
 
@@ -146,7 +149,7 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 
 sub no_upwards {
     my $self = shift;
-    return grep(!/^\.{1,2}\z/s, @_);
+    return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
 }
 
 =item case_tolerant
@@ -223,7 +226,7 @@ sub splitpath {
         $directory = $path;
     }
     else {
-        $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
+        $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
         $directory = $1;
         $file      = $2;
     }
@@ -242,11 +245,13 @@ $directories must be only the directory portion of the path on systems
 that have the concept of a volume or that have path syntax that differentiates
 files from directories.
 
-Unlike just splitting the directories on the separator, leading empty and 
-trailing directory entries can be returned, because these are significant
-on some OSs. So,
+Unlike just splitting the directories on the separator, empty
+directory names (C<''>) can be returned, because these are significant
+on some OSs (e.g. MacOS).
+
+On Unix,
 
-    File::Spec->splitdir( "/a/b/c" );
+    File::Spec->splitdir( "/a/b//c/" );
 
 Yields:
 
@@ -261,7 +266,7 @@ sub splitdir {
     # check to be sure that there will not be any before handling the
     # simple case.
     #
-    if ( $directories !~ m|/\z| ) {
+    if ( $directories !~ m|/\Z(?!\n)| ) {
         return split( m|/|, $directories );
     }
     else {
diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index a2ac8cac0b..d2be87c660 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -1,8 +1,11 @@
 package File::Spec::VMS;
 
 use strict;
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
+
+$VERSION = '1.1';
+
 @ISA = qw(File::Spec::Unix);
 
 use Cwd;
@@ -56,7 +59,7 @@ sub eliminate_macros {
                     $complex = 1;
                 }
             }
-            else { ($macro = unixify($self->{$macro})) =~ s#/\z##; }
+            else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
             $npath = "$head$macro$tail";
         }
     }
@@ -86,8 +89,8 @@ sub fixpath {
     $self = bless {} unless ref $self;
     my($fixedpath,$prefix,$name);
 
-    if ($path =~ m#^\$\([^\)]+\)\z#s || $path =~ m#[/:>\]]#) { 
-        if ($force_path or $path =~ /(?:DIR\)|\])\z/) {
+    if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
             $fixedpath = vmspath($self->eliminate_macros($path));
         }
         else {
@@ -97,7 +100,7 @@ sub fixpath {
     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
         my($vmspre) = $self->eliminate_macros("\$($prefix)");
         # is it a dir or just a name?
-        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\z/) ? vmspath($vmspre) : '';
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
         $fixedpath = vmspath($fixedpath) if $force_path;
     }
@@ -136,7 +139,7 @@ sub canonpath {
     my($self,$path) = @_;
 
     if ($path =~ m|/|) { # Fake Unix
-      my $pathify = $path =~ m|/\z|;
+      my $pathify = $path =~ m|/\Z(?!\n)|;
       $path = $self->SUPER::canonpath($path);
       if ($pathify) { return vmspath($path); }
       else          { return vmsify($path);  }
@@ -169,8 +172,8 @@ sub catdir {
     if (@dirs) {
 	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
 	my ($spath,$sdir) = ($path,$dir);
-	$spath =~ s/\.dir\z//; $sdir =~ s/\.dir\z//; 
-	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s;
+	$spath =~ s/\.dir\Z(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//; 
+	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
 	$rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
 
 	# Special case for VMS absolute directory specs: these will have had device
@@ -181,7 +184,7 @@ sub catdir {
     }
     else {
 	if    (not defined $dir or not length $dir) { $rslt = ''; }
-	elsif ($dir =~ /^\$\([^\)]+\)\z/s)          { $rslt = $dir; }
+	elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s)          { $rslt = $dir; }
 	else                                        { $rslt = vmspath($dir); }
     }
     return $self->canonpath($rslt);
@@ -202,8 +205,8 @@ sub catfile {
     if (@files) {
 	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
 	my $spath = $path;
-	$spath =~ s/\.dir\z//;
-	if ($spath =~ /^[^\)\]\/:>]+\)\z/s && basename($file) eq $file) {
+	$spath =~ s/\.dir\Z(?!\n)//;
+	if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
 	    $rslt = "$spath$file";
 	}
 	else {
@@ -310,7 +313,7 @@ Checks for VMS directory spec as well as Unix separators.
 sub file_name_is_absolute {
     my ($self,$file) = @_;
     # If it's a logical name, expand it.
-    $file = $ENV{$file} while $file =~ /^[\w\$\-]+\z/s && $ENV{$file};
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
     return scalar($file =~ m!^/!s             ||
 		  $file =~ m![<\[][^.\-\]>]!  ||
 		  $file =~ /:[^<\[]/);
@@ -341,7 +344,7 @@ sub splitdir {
     $dirspec =~ s/\]\[//g;  $dirspec =~ s/\-\-/-.-/g;
     $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
     my(@dirs) = split('\.', vmspath($dirspec));
-    $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\z//s;
+    $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
     @dirs;
 }
 
@@ -355,7 +358,7 @@ Construct a complete filespec using VMS syntax
 sub catpath {
     my($self,$dev,$dir,$file) = @_;
     if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
-    else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; }
+    else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
     if (length($dev) or length($dir)) {
       $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
       $dir = vmspath($dir);
@@ -400,17 +403,16 @@ sub abs2rel {
     }
 
     # Split up paths
-    my ( undef, $path_directories, $path_file ) =
-        $self->splitpath( $path, 1 ) ;
+    my ( $path_directories, $path_file ) =
+        ($self->splitpath( $path, 1 ))[1,2] ;
 
     $path_directories = $1
-        if $path_directories =~ /^\[(.*)\]\z/s ;
+        if $path_directories =~ /^\[(.*)\]\Z(?!\n)/s ;
 
-    my ( undef, $base_directories, undef ) =
-        $self->splitpath( $base, 1 ) ;
+    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
 
     $base_directories = $1
-        if $base_directories =~ /^\[(.*)\]\z/s ;
+        if $base_directories =~ /^\[(.*)\]\Z(?!\n)/s ;
 
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_directories );
@@ -427,7 +429,7 @@ sub abs2rel {
     # @basechunks now contains the directories to climb out of,
     # @pathchunks now has the directories to descend in to.
     $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ;
-    $path_directories =~ s{\.\z}{} ;
+    $path_directories =~ s{\.\Z(?!\n)}{} ;
     return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
 }
 
@@ -458,17 +460,17 @@ sub rel2abs($;$;) {
         }
 
         # Split up paths
-        my ( undef, $path_directories, $path_file ) =
-            $self->splitpath( $path ) ;
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path ))[1,2] ;
 
-        my ( $base_volume, $base_directories, undef ) =
+        my ( $base_volume, $base_directories ) =
             $self->splitpath( $base ) ;
 
         $path_directories = '' if $path_directories eq '[]' ||
                                   $path_directories eq '<>';
         my $sep = '' ;
         $sep = '.'
-            if ( $base_directories =~ m{[^.\]>]\z} &&
+            if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
                  $path_directories =~ m{^[^.\[<]}s
             ) ;
         $base_directories = "$base_directories$sep$path_directories";
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index aa95fbde36..b8fe37bbdb 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -2,8 +2,11 @@ package File::Spec::Win32;
 
 use strict;
 use Cwd;
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
+
+$VERSION = '1.1';
+
 @ISA = qw(File::Spec::Unix);
 
 =head1 NAME
@@ -105,8 +108,8 @@ sub canonpath {
     $path =~ s|([^\\])\\+|$1\\|g;                  # xx////xx  -> xx/xx
     $path =~ s|(\\\.)+\\|\\|g;                     # xx/././xx -> xx/xx
     $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # ./xx      -> xx
-    $path =~ s|\\\z||
-             unless $path =~ m#^([A-Z]:)?\\\z#s;   # xx/       -> xx
+    $path =~ s|\\\Z(?!\n)||
+             unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx/       -> xx
     return $path;
 }
 
@@ -146,7 +149,7 @@ sub splitpath {
                       (?:\\\\|//)[^\\/]+[\\/][^\\/]+
                   )?
                 )
-                ( (?:.*[\\\\/](?:\.\.?\z)?)? )
+                ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
                 (.*)
              }xs;
         $volume    = $1;
@@ -187,7 +190,7 @@ sub splitdir {
     # check to be sure that there will not be any before handling the
     # simple case.
     #
-    if ( $directories !~ m|[\\/]\z| ) {
+    if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
         return split( m|[\\/]|, $directories );
     }
     else {
@@ -216,7 +219,7 @@ sub catpath {
     # If it's UNC, make sure the glue separator is there, reusing
     # whatever separator is first in the $volume
     $volume .= $1
-        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
+        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
              $directory =~ m@^[^\\/]@s
            ) ;
 
@@ -224,8 +227,8 @@ sub catpath {
 
     # If the volume is not just A:, make sure the glue separator is 
     # there, reusing whatever separator is first in the $volume if possible.
-    if ( $volume !~ m@^[a-zA-Z]:\z@s &&
-         $volume =~ m@[^\\/]\z@      &&
+    if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
+         $volume =~ m@[^\\/]\Z(?!\n)@      &&
          $file   =~ m@[^\\/]@
        ) {
         $volume =~ m@([\\/])@ ;
@@ -293,8 +296,7 @@ sub abs2rel {
     my ( $path_volume, $path_directories, $path_file ) =
         $self->splitpath( $path, 1 ) ;
 
-    my ( undef, $base_directories, undef ) =
-        $self->splitpath( $base, 1 ) ;
+    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
 
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_directories );
@@ -378,10 +380,10 @@ sub rel2abs($;$;) {
             $base = $self->canonpath( $base ) ;
         }
 
-        my ( undef, $path_directories, $path_file ) =
-            $self->splitpath( $path, 1 ) ;
+        my ( $path_directories, $path_file ) =
+            ($self->splitpath( $path, 1 ))[1,2] ;
 
-        my ( $base_volume, $base_directories, undef ) =
+        my ( $base_volume, $base_directories ) =
             $self->splitpath( $base, 1 ) ;
 
         $path = $self->catpath( 
diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm
new file mode 100644
index 0000000000..736ef3fdb3
--- /dev/null
+++ b/lib/File/Temp.pm
@@ -0,0 +1,1584 @@
+package File::Temp;
+
+=head1 NAME
+
+File::Temp - return name and handle of a temporary file safely
+
+=head1 SYNOPSIS
+
+  use File::Temp qw/ tempfile tempdir /; 
+
+  $dir = tempdir( CLEANUP => 1 );
+  ($fh, $filename) = tempfile( DIR => $dir );
+
+  ($fh, $filename) = tempfile( $template, DIR => $dir);
+  ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
+
+  $fh = tempfile();
+
+MkTemp family:
+
+  use File::Temp qw/ :mktemp  /;
+
+  ($fh, $file) = mkstemp( "tmpfileXXXXX" );
+  ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
+
+  $tmpdir = mkdtemp( $template );
+
+  $unopened_file = mktemp( $template );
+
+POSIX functions:
+
+  use File::Temp qw/ :POSIX /;
+
+  $file = tmpnam();
+  $fh = tmpfile();
+
+  ($fh, $file) = tmpnam();
+  ($fh, $file) = tmpfile();
+
+
+Compatibility functions:
+
+  $unopened_file = File::Temp::tempnam( $dir, $pfx );
+
+=begin later
+
+Objects (NOT YET IMPLEMENTED):
+
+  require File::Temp;
+
+  $fh = new File::Temp($template);
+  $fname = $fh->filename;
+
+=end later
+
+=head1 DESCRIPTION
+
+C<File::Temp> can be used to create and open temporary files in a safe way.
+The tempfile() function can be used to return the name and the open
+filehandle of a temporary file.  The tempdir() function can 
+be used to create a temporary directory.
+
+The security aspect of temporary file creation is emphasized such that
+a filehandle and filename are returned together.  This helps guarantee that 
+a race condition can not occur where the temporary file is created by another process 
+between checking for the existence of the file and its
+opening.  Additional security levels are provided to check, for 
+example, that the sticky bit is set on world writable directories.
+See L<"safe_level"> for more information.
+
+For compatibility with popular C library functions, Perl implementations of
+the mkstemp() family of functions are provided. These are, mkstemp(),
+mkstemps(), mkdtemp() and mktemp().
+
+Additionally, implementations of the standard L<POSIX|POSIX>
+tmpnam() and tmpfile() functions are provided if required.
+
+Implementations of mktemp(), tmpnam(), and tempnam() are provided,
+but should be used with caution since they return only a filename
+that was valid when function was called, so cannot guarantee
+that the file will not exist by the time the caller opens the filename.
+
+=cut
+
+# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
+# People would like a version on 5.005 so give them what they want :-)
+use 5.005;
+use strict;
+use Carp;
+use File::Spec 0.8;
+use File::Path qw/ rmtree /;
+use Fcntl 1.03;
+use Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
+
+# use 'our' on v5.6.0
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
+
+$DEBUG = 0;
+
+# We are exporting functions
+
+#require Exporter;
+#@ISA = qw/Exporter/;
+use base qw/Exporter/;
+
+# Export list - to allow fine tuning of export table
+
+@EXPORT_OK = qw{
+	      tempfile
+	      tempdir
+	      tmpnam
+	      tmpfile
+	      mktemp
+	      mkstemp 
+	      mkstemps
+	      mkdtemp
+	      unlink0
+		};
+
+# Groups of functions for export
+
+%EXPORT_TAGS = (
+		'POSIX' => [qw/ tmpnam tmpfile /],
+		'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+	       );
+
+# add contents of these tags to @EXPORT
+Exporter::export_tags('POSIX','mktemp');
+
+# Version number 
+
+$VERSION = '0.07';
+
+# This is a list of characters that can be used in random filenames
+
+my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+	         a b c d e f g h i j k l m n o p q r s t u v w x y z
+	         0 1 2 3 4 5 6 7 8 9 _ 
+	     /);
+
+# Maximum number of tries to make a temp file before failing
+
+use constant MAX_TRIES => 10;
+
+# Minimum number of X characters that should be in a template
+use constant MINX => 4;
+
+# Default template when no template supplied
+
+use constant TEMPXXX => 'X' x 10;
+
+# Constants for the security level
+
+use constant STANDARD => 0;
+use constant MEDIUM   => 1;
+use constant HIGH     => 2;
+
+# INTERNAL ROUTINES - not to be used outside of package
+
+# Generic routine for getting a temporary filename
+# modelled on OpenBSD _gettemp() in mktemp.c
+
+# The template must contain X's that are to be replaced 
+# with the random values
+
+#  Arguments:
+
+#  TEMPLATE   - string containing the XXXXX's that is converted
+#           to a random filename and opened if required
+
+# Optionally, a hash can also be supplied containing specific options
+#   "open" => if true open the temp file, else just return the name
+#             default is 0
+#   "mkdir"=> if true, we are creating a temp directory rather than tempfile
+#             default is 0
+#   "suffixlen" => number of characters at end of PATH to be ignored.
+#                  default is 0.
+# "open" and "mkdir" can not both be true
+
+# The default options are equivalent to mktemp().
+
+# Returns:
+#   filehandle - open file handle (if called with doopen=1, else undef)
+#   temp name  - name of the temp file or directory
+
+# For example:
+#   ($fh, $name) = _gettemp($template, "open" => 1);
+
+# for the current version, failures are associated with
+# a carp to give the reason whilst debugging
+
+sub _gettemp {
+
+  croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
+    unless scalar(@_) >= 1;
+
+  # Default options
+  my %options = (
+		 "open" => 0,
+		 "mkdir" => 0,
+		 "suffixlen" => 0,
+		);
+
+  # Read the template
+  my $template = shift;
+  if (ref($template)) {
+    carp "File::Temp::_gettemp: template must not be a reference";
+    return ();
+  }
+
+  # Check that the number of entries on stack are even
+  if (scalar(@_) % 2 != 0) {
+    carp "File::Temp::_gettemp: Must have even number of options";
+    return ();
+  }
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+  
+  # Can not open the file and make a directory in a single call
+  if ($options{"open"} && $options{"mkdir"}) {
+    carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n";
+    return ();
+  }
+
+  # Find the start of the end of the  Xs (position of last X)
+  # Substr starts from 0
+  my $start = length($template) - 1 - $options{"suffixlen"};
+
+  # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
+  # (taking suffixlen into account). Any fewer is insecure.
+
+  # Do it using substr - no reason to use a pattern match since
+  # we know where we are looking and what we are looking for
+
+  if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
+    carp "File::Temp::_gettemp: The template must contain at least ". MINX ." 'X' characters\n";
+    return ();
+  }
+
+  # Replace all the X at the end of the substring with a
+  # random character or just all the XX at the end of a full string.
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # and generate a full path from the template
+
+  my $path = _replace_XX($template, $options{"suffixlen"});
+
+
+  # Split the path into constituent parts - eventually we need to check
+  # whether the directory exists
+  # We need to know whether we are making a temp directory
+  # or a tempfile
+
+  my ($volume, $directories, $file);
+  my $parent; # parent directory
+  if ($options{"mkdir"}) {
+    # There is no filename at the end
+    ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
+
+    # The parent is then $directories without the last directory
+    # Split the directory and put it back together again
+    my @dirs = File::Spec->splitdir($directories);
+
+    # If @dirs only has one entry that means we are in the current
+    # directory
+    if ($#dirs == 0) {
+      $parent = File::Spec->curdir;
+    } else {
+
+      # Put it back together without the last one
+      $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
+
+      # ...and attach the volume (no filename)
+      $parent = File::Spec->catpath($volume, $parent, '');
+
+    }
+
+  } else {
+
+    # Get rid of the last filename (use File::Basename for this?)
+    ($volume, $directories, $file) = File::Spec->splitpath( $path );
+
+    # Join up without the file part
+    $parent = File::Spec->catpath($volume,$directories,'');
+
+    # If $parent is empty replace with curdir
+    $parent = File::Spec->curdir
+      unless $directories ne '';
+
+  }
+
+  # Check that the parent directories exist 
+  # Do this even for the case where we are simply returning a name
+  # not a file -- no point returning a name that includes a directory
+  # that does not exist or is not writable
+
+  unless (-d $parent && -w _) {
+    carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory" 
+      . " or is not writable\n";
+      return ();
+  }
+
+  # Check the stickiness of the directory and chown giveaway if required
+  # If the directory is world writable the sticky bit
+  # must be set
+
+  if (File::Temp->safe_level == MEDIUM) {
+    unless (_is_safe($parent)) {
+      carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+      return ();
+    }
+  } elsif (File::Temp->safe_level == HIGH) {
+    unless (_is_verysafe($parent)) {
+      carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+      return ();
+    }
+  }
+
+
+  # Calculate the flags that we wish to use for the sysopen
+  # Some of these are not always available
+  my $openflags;
+  if ($options{"open"}) {
+    # Default set
+    $openflags = O_CREAT | O_EXCL | O_RDWR;
+
+    for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
+        my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+        no strict 'refs';
+        $openflags |= $bit if eval { $bit = &$func(); 1 };
+    }
+
+  }
+  
+
+  # Now try MAX_TRIES time to open the file
+  for (my $i = 0; $i < MAX_TRIES; $i++) {
+
+    # Try to open the file if requested
+    if ($options{"open"}) {
+      my $fh;
+
+      # If we are running before perl5.6.0 we can not auto-vivify
+      if ($] < 5.006) {
+	require Symbol;
+	$fh = &Symbol::gensym;
+      }
+
+      # Try to make sure this will be marked close-on-exec
+      # XXX: Win32 doesn't respect this, nor the proper fcntl,
+      #      but may have O_NOINHERIT. This may or may not be in Fcntl.
+      local $^F = 2; 
+
+      # Store callers umask
+      my $umask = umask();
+
+      # Set a known umask
+      umask(066);
+
+      # Attempt to open the file
+      if ( sysopen($fh, $path, $openflags, 0600) ) {
+
+	# Reset umask
+	umask($umask);
+	
+	# Opened successfully - return file handle and name
+	return ($fh, $path);
+
+      } else {
+	# Reset umask
+	umask($umask);
+
+	# Error opening file - abort with error
+	# if the reason was anything but EEXIST
+	unless ($! == EEXIST) {
+	  carp "File::Temp: Could not create temp file $path: $!";
+	  return ();
+	}
+
+	# Loop round for another try
+	
+      }
+    } elsif ($options{"mkdir"}) {
+
+      # Store callers umask
+      my $umask = umask();
+
+      # Set a known umask
+      umask(066);
+
+      # Open the temp directory
+      if (mkdir( $path, 0700)) {
+	# created okay
+	# Reset umask
+	umask($umask);
+
+	return undef, $path;
+      } else {
+
+	# Reset umask
+	umask($umask);
+
+	# Abort with error if the reason for failure was anything
+	# except EEXIST
+	unless ($! == EEXIST) {
+	  carp "File::Temp: Could not create directory $path: $!";
+	  return ();
+	}
+
+	# Loop round for another try
+
+      }
+
+    } else {
+
+      # Return true if the file can not be found
+      # Directory has been checked previously
+
+      return (undef, $path) unless -e $path;
+
+      # Try again until MAX_TRIES 
+
+    }
+    
+    # Did not successfully open the tempfile/dir
+    # so try again with a different set of random letters
+    # No point in trying to increment unless we have only
+    # 1 X say and the randomness could come up with the same
+    # file MAX_TRIES in a row.
+
+    # Store current attempt - in principal this implies that the
+    # 3rd time around the open attempt that the first temp file
+    # name could be generated again. Probably should store each
+    # attempt and make sure that none are repeated
+
+    my $original = $path;
+    my $counter = 0;  # Stop infinite loop
+    my $MAX_GUESS = 50;
+
+    do {
+
+      # Generate new name from original template
+      $path = _replace_XX($template, $options{"suffixlen"});
+
+      $counter++;
+
+    } until ($path ne $original || $counter > $MAX_GUESS);
+
+    # Check for out of control looping
+    if ($counter > $MAX_GUESS) {
+      carp "Tried to get a new temp name different to the previous value$MAX_GUESS times.\nSomething wrong with template?? ($template)";
+      return ();
+    }
+
+  }
+
+  # If we get here, we have run out of tries
+  carp "Have exceeded the maximum number of attempts (".MAX_TRIES .
+    ") to open temp file/dir";
+
+  return ();
+
+}
+
+# Internal routine to return a random character from the
+# character list. Does not do an srand() since rand()
+# will do one automatically
+
+# No arguments. Return value is the random character
+
+sub _randchar {
+
+  $CHARS[ int( rand( $#CHARS ) ) ];
+
+}
+
+# Internal routine to replace the XXXX... with random characters
+# This has to be done by _gettemp() every time it fails to 
+# open a temp file/dir
+
+# Arguments:  $template (the template with XXX), 
+#             $ignore   (number of characters at end to ignore)
+
+# Returns:    modified template
+
+sub _replace_XX {
+
+  croak 'Usage: _replace_XX($template, $ignore)'
+    unless scalar(@_) == 2;
+
+  my ($path, $ignore) = @_;
+
+  # Do it as an if, since the suffix adjusts which section to replace
+  # and suffixlen=0 returns nothing if used in the substr directly
+  # Alternatively, could simply set $ignore to length($path)-1
+  # Don't want to always use substr when not required though.
+
+  if ($ignore) {
+    substr($path, 0, - $ignore) =~ s/X(?=X*\z)/_randchar()/ge;
+  } else {
+    $path =~ s/X(?=X*\z)/_randchar()/ge;
+  }
+
+  return $path;
+}
+
+# internal routine to check to see if the directory is safe
+# First checks to see if the directory is not owned by the 
+# current user or root. Then checks to see if anyone else
+# can write to the directory and if so, checks to see if 
+# it has the sticky bit set
+
+# Will not work on systems that do not support sticky bit
+
+#Args:  directory path to check
+# Returns true if the path is safe and false otherwise.
+# Returns undef if can not even run stat() on the path
+
+# This routine based on version written by Tom Christiansen
+
+# Presumably, by the time we actually attempt to create the
+# file or directory in this directory, it may not be safe
+# anymore... Have to run _is_safe directly after the open.
+
+sub _is_safe {
+
+  my $path = shift;
+
+  # Stat path
+  my @info = stat($path);
+  return 0 unless scalar(@info);
+
+  # Check to see whether owner is neither superuser (or a system uid) nor me
+  # Use the real uid from the $< variable
+  # UID is in [4]
+  if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+    carp "Directory owned neither by root nor the current user";
+    return 0;
+  }
+
+  # check whether group or other can write file
+  # use 066 to detect either reading or writing
+  # use 022 to check writability
+  # Do it with S_IWOTH and S_IWGRP for portability (maybe)
+  # mode is in info[2]
+  if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
+      ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
+    return 0 unless -d _;       # Must be a directory
+    return 0 unless -k _;       # Must be sticky
+  }
+
+  return 1;
+}
+
+# Internal routine to check whether a directory is safe
+# for temp files. Safer than _is_safe since it checks for 
+# the possibility of chown giveaway and if that is a possibility
+# checks each directory in the path to see if it is safe (with _is_safe)
+
+# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
+# directory anyway.
+
+sub _is_verysafe {
+
+  # Need POSIX - but only want to bother if really necessary due to overhead
+  require POSIX;
+
+  my $path = shift;
+
+  # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
+  # and If it is not there do the extensive test
+  my $chown_restricted;
+  $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
+    if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
+
+  # If chown_resticted is set to some value we should test it
+  if (defined $chown_restricted) {
+
+    # Return if the current directory is safe
+    return _is_safe($path) if POSIX::sysconf( $chown_restricted );
+
+  }
+
+  # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
+  # was not avialable or the symbol was there but chown giveaway
+  # is allowed. Either way, we now have to test the entire tree for
+  # safety.
+
+  # Convert path to an absolute directory if required
+  unless (File::Spec->file_name_is_absolute($path)) {
+    $path = File::Spec->rel2abs($path);
+  }
+
+  # Split directory into components - assume no file
+  my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
+
+  # Slightly less efficient than having a a function in File::Spec
+  # to chop off the end of a directory or even a function that
+  # can handle ../ in a directory tree
+  # Sometimes splitdir() returns a blank at the end
+  # so we will probably check the bottom directory twice in some cases
+  my @dirs = File::Spec->splitdir($directories);
+
+  # Concatenate one less directory each time around
+  foreach my $pos (0.. $#dirs) {
+    # Get a directory name
+    my $dir = File::Spec->catpath($volume,
+				  File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
+				  ''
+				  );
+
+    print "TESTING DIR $dir\n" if $DEBUG;
+
+    # Check the directory
+    return 0 unless _is_safe($dir);
+
+  }
+
+  return 1;
+}
+
+
+
+# internal routine to determine whether unlink works on this
+# platform for files that are currently open.
+# Returns true if we can, false otherwise.
+
+# Currently WinNT can not unlink an opened file
+
+sub _can_unlink_opened_file {
+
+  
+  $^O ne 'MSWin32' ? 1 : 0;
+
+}
+
+
+# This routine sets up a deferred unlinking of a specified
+# filename and filehandle. It is used in the following cases:
+#  - Called by unlink0 if an opend file can not be unlinked
+#  - Called by tempfile() if files are to be removed on shutdown
+#  - Called by tempdir() if directories are to be removed on shutdown
+
+# Arguments:
+#   _deferred_unlink( $fh, $fname, $isdir );
+#
+#   - filehandle (so that it can be expclicitly closed if open
+#   - filename   (the thing we want to remove)
+#   - isdir      (flag to indicate that we are being given a directory)
+#                 [and hence no filehandle]
+
+# Status is not referred since all the magic is done with END blocks
+
+sub _deferred_unlink {
+
+  croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
+    unless scalar(@_) == 3;
+
+  my ($fh, $fname, $isdir) = @_;
+
+  warn "Setting up deferred removal of $fname\n"
+    if $DEBUG;
+
+  # If we have a directory, check that it is a directory
+  if ($isdir) {
+
+    if (-d $fname) {
+
+      # Directory exists so set up END block
+      # (quoted to preserve lexical variables)
+      eval q{
+	END {
+	  if (-d $fname) {
+	    rmtree($fname, $DEBUG, 1);
+	  }
+	}
+	1;
+      }  || die;
+
+    } else {
+      carp "Request to remove directory $fname could not be completed since it does not exists!\n";
+    }
+
+
+  } else {
+
+    if (-f $fname) {
+
+      # dile exists so set up END block
+      # (quoted to preserve lexical variables)
+      eval q{
+	END {
+	  # close the filehandle without checking its state
+	  # in order to make real sure that this is closed
+	  # if its already closed then I dont care about the answer
+	  # probably a better way to do this
+	  close($fh);
+
+	  if (-f $fname) {
+	    unlink $fname
+	      || warn "Error removing $fname";
+	  }
+	}
+	1;
+      } || die;
+
+    } else {
+      carp "Request to remove file $fname could not be completed since it is not there!\n";
+    }
+
+
+    
+  }
+
+}
+
+
+=head1 FUNCTIONS
+
+This section describes the recommended interface for generating
+temporary files and directories.
+
+=over 4
+
+=item B<tempfile>
+
+This is the basic function to generate temporary files.
+The behaviour of the file can be changed using various options:
+
+  ($fh, $filename) = tempfile();
+
+Create a temporary file in  the directory specified for temporary
+files, as specified by the tmpdir() function in L<File::Spec>.
+
+  ($fh, $filename) = tempfile($template);
+
+Create a temporary file in the current directory using the supplied
+template.  Trailing `X' characters are replaced with random letters to
+generate the filename.  At least four `X' characters must be present
+in the template.
+
+  ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
+
+Same as previously, except that a suffix is added to the template
+after the `X' translation.  Useful for ensuring that a temporary
+filename has a particular extension when needed by other applications.
+But see the WARNING at the end.
+
+  ($fh, $filename) = tempfile($template, DIR => $dir);
+
+Translates the template as before except that a directory name
+is specified.
+
+If the template is not specified, a template is always
+automatically generated. This temporary file is placed in tmpdir()
+(L<File::Spec>) unless a directory is specified explicitly with the 
+DIR option.
+
+  $fh = tempfile( $template, DIR => $dir );
+
+If called in scalar context, only the filehandle is returned
+and the file will automatically be deleted when closed (see 
+the description of tmpfile() elsewhere in this document).
+This is the preferred mode of operation, as if you only 
+have a filehandle, you can never create a race condition
+by fumbling with the filename. On systems that can not unlink
+an open file (for example, Windows NT) the file is marked for
+deletion when the program ends (equivalent to setting UNLINK to 1).
+
+  (undef, $filename) = tempfile($template, OPEN => 0);
+
+This will return the filename based on the template but
+will not open this file.  Cannot be used in conjunction with
+UNLINK set to true. Default is to always open the file 
+to protect from possible race conditions. A warning is issued
+if warnings are turned on. Consider using the tmpnam()
+and mktemp() functions described elsewhere in this document
+if opening the file is not required.
+
+=cut
+
+sub tempfile {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+		 "DIR"    => undef,  # Directory prefix
+		 "SUFFIX" => '',      # Template suffix
+		 "UNLINK" => 0,      # Unlink file on exit
+		 "OPEN"   => 1,      # Do not open file
+		);
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # First decision is whether or not to open the file
+  if (! $options{"OPEN"}) {
+
+    warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
+      if $^W;
+
+  }
+
+  # Construct the template 
+
+  # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
+  # functions or simply constructing a template and using _gettemp()
+  # explicitly. Go for the latter
+
+  # First generate a template if not defined and prefix the directory
+  # If no template must prefix the temp directory
+  if (defined $template) {
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, $template);
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
+
+    } else {
+      
+      $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
+
+    }
+    
+  }
+
+  # Now add a suffix
+  $template .= $options{"SUFFIX"};
+
+  # Create the file
+  my ($fh, $path);
+  croak "Error in tempfile() using $template"
+    unless (($fh, $path) = _gettemp($template,
+				    "open" => $options{'OPEN'}, 
+				    "mkdir"=> 0 ,
+				    "suffixlen" => length($options{'SUFFIX'}),
+				   ) );  
+
+  # Set up an exit handler that can do whatever is right for the
+  # system. Do not check return status since this is all done with
+  # END blocks
+  _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
+  
+  # Return
+  if (wantarray()) {
+
+    if ($options{'OPEN'}) {
+      return ($fh, $path);
+    } else {
+      return (undef, $path);
+    }
+
+  } else {
+
+    # Unlink the file. It is up to unlink0 to decide what to do with
+    # this (whether to unlink now or to defer until later)
+    unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
+    
+    # Return just the filehandle.
+    return $fh;
+  }
+
+
+}
+
+=item B<tempdir>
+
+This is the recommended interface for creation of temporary directories.
+The behaviour of the function depends on the arguments:
+
+  $tempdir = tempdir();
+
+Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
+
+  $tempdir = tempdir( $template );
+
+Create a directory from the supplied template. This template is
+similar to that described for tempfile(). `X' characters at the end
+of the template are replaced with random letters to construct the
+directory name. At least four `X' characters must be in the template.
+
+  $tempdir = tempdir ( DIR => $dir );
+
+Specifies the directory to use for the temporary directory.
+The temporary directory name is derived from an internal template.
+
+  $tempdir = tempdir ( $template, DIR => $dir );
+
+Prepend the supplied directory name to the template. The template
+should not include parent directory specifications itself. Any parent
+directory specifications are removed from the template before
+prepending the supplied directory.
+
+  $tempdir = tempdir ( $template, TMPDIR => 1 );
+
+Using the supplied template, creat the temporary directory in 
+a standard location for temporary files. Equivalent to doing
+
+  $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
+
+but shorter. Parent directory specifications are stripped from the
+template itself. The C<TMPDIR> option is ignored if C<DIR> is set
+explicitly.  Additionally, C<TMPDIR> is implied if neither a template
+nor a directory are supplied.
+
+  $tempdir = tempdir( $template, CLEANUP => 1);
+
+Create a temporary directory using the supplied template, but 
+attempt to remove it (and all files inside it) when the program
+exits. Note that an attempt will be made to remove all files from
+the directory even if they were not created by this module (otherwise
+why ask to clean it up?). The directory removal is made with
+the rmtree() function from the L<File::Path|File::Path> module.
+Of course, if the template is not specified, the temporary directory
+will be created in tmpdir() and will also be removed at program exit.
+
+=cut
+
+# '
+
+sub tempdir  {
+
+  # Can not check for argument count since we can have any
+  # number of args
+
+  # Default options
+  my %options = (
+		 "CLEANUP"    => 0,  # Remove directory on exit
+		 "DIR"        => '', # Root directory
+		 "TMPDIR"     => 0,  # Use tempdir with template
+		);
+
+  # Check to see whether we have an odd or even number of arguments
+  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+
+  # Read the options and merge with defaults
+  %options = (%options, @_)  if @_;
+
+  # Modify or generate the template
+
+  # Deal with the DIR and TMPDIR options
+  if (defined $template) {
+
+    # Need to strip directory path if using DIR or TMPDIR
+    if ($options{'TMPDIR'} || $options{'DIR'}) {
+
+      # Strip parent directory from the filename
+      # 
+      # There is no filename at the end
+      my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
+
+      # Last directory is then our template
+      $template = (File::Spec->splitdir($directories))[-1];
+
+      # Prepend the supplied directory or temp dir
+      if ($options{"DIR"}) {
+
+	$template = File::Spec->catfile($options{"DIR"}, $template);
+
+      } elsif ($options{TMPDIR}) {
+
+	# Prepend tmpdir
+	$template = File::Spec->catdir(File::Spec->tmpdir, $template);
+
+      }
+
+    }
+
+  } else {
+
+    if ($options{"DIR"}) {
+
+      $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
+
+    } else {
+      
+      $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
+
+    }
+    
+  }
+
+  # Create the directory
+  my $tempdir;
+  croak "Error in tempdir() using $template"
+    unless ((undef, $tempdir) = _gettemp($template,
+				    "open" => 0, 
+				    "mkdir"=> 1 ,
+				    "suffixlen" => 0,
+				   ) );  
+  
+  # Install exit handler; must be dynamic to get lexical
+  if ( $options{'CLEANUP'} && -d $tempdir) { 
+    _deferred_unlink(undef, $tempdir, 1);
+  } 
+
+  # Return the dir name
+  return $tempdir;
+
+}
+
+=back
+
+=head1 MKTEMP FUNCTIONS
+
+The following functions are Perl implementations of the 
+mktemp() family of temp file generation system calls.
+
+=over 4
+
+=item B<mkstemp>
+
+Given a template, returns a filehandle to the temporary file and the name
+of the file.
+
+  ($fh, $name) = mkstemp( $template );
+
+In scalar context, just the filehandle is returned.
+
+The template may be any filename with some number of X's appended
+to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
+with unique alphanumeric combinations.
+
+=cut
+
+
+
+sub mkstemp {
+
+  croak "Usage: mkstemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($fh, $path);
+  croak "Error in mkstemp using $template"
+    unless (($fh, $path) = _gettemp($template, 
+				    "open" => 1, 
+				    "mkdir"=> 0 ,
+				    "suffixlen" => 0,
+				   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+
+=item B<mkstemps>
+
+Similar to mkstemp(), except that an extra argument can be supplied
+with a suffix to be appended to the template.
+
+  ($fh, $name) = mkstemps( $template, $suffix );
+
+For example a template of C<testXXXXXX> and suffix of C<.dat>
+would generate a file similar to F<testhGji_w.dat>.
+
+Returns just the filehandle alone when called in scalar context.
+
+=cut
+
+sub mkstemps {
+
+  croak "Usage: mkstemps(template, suffix)"
+    if scalar(@_) != 2;
+
+
+  my $template = shift;
+  my $suffix   = shift;
+
+  $template .= $suffix;
+  
+  my ($fh, $path);
+  croak "Error in mkstemps using $template"
+    unless (($fh, $path) = _gettemp($template,
+				    "open" => 1, 
+				    "mkdir"=> 0 ,
+				    "suffixlen" => length($suffix),
+				   ) );
+
+  if (wantarray()) {
+    return ($fh, $path);
+  } else {
+    return $fh;
+  }
+
+}
+
+=item B<mkdtemp>
+
+Create a directory from a template. The template must end in
+X's that are replaced by the routine.
+
+  $tmpdir_name = mkdtemp($template);
+
+Returns the name of the temporary directory created.
+Returns undef on failure.
+
+Directory must be removed by the caller.
+
+=cut
+
+#' # for emacs
+
+sub mkdtemp {
+
+  croak "Usage: mkdtemp(template)"
+    if scalar(@_) != 1;
+  
+  my $template = shift;
+
+  my ($junk, $tmpdir);
+  croak "Error creating temp directory from template $template\n"
+    unless (($junk, $tmpdir) = _gettemp($template,
+					"open" => 0, 
+					"mkdir"=> 1 ,
+					"suffixlen" => 0,
+				       ) );
+
+  return $tmpdir;
+
+}
+
+=item B<mktemp>
+
+Returns a valid temporary filename but does not guarantee
+that the file will not be opened by someone else.
+
+  $unopened_file = mktemp($template);
+
+Template is the same as that required by mkstemp().
+
+=cut
+
+sub mktemp {
+
+  croak "Usage: mktemp(template)"
+    if scalar(@_) != 1;
+
+  my $template = shift;
+
+  my ($tmpname, $junk);
+  croak "Error getting name to temp file from template $template\n"
+    unless (($junk, $tmpname) = _gettemp($template,
+					 "open" => 0, 
+					 "mkdir"=> 0 ,
+					 "suffixlen" => 0,
+					 ) );
+
+  return $tmpname;
+}
+
+=back
+
+=head1 POSIX FUNCTIONS
+
+This section describes the re-implementation of the tmpnam()
+and tmpfile() functions described in L<POSIX> 
+using the mkstemp() from this module.
+
+Unlike the L<POSIX|POSIX> implementations, the directory used
+for the temporary file is not specified in a system include
+file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
+returned by L<File::Spec|File::Spec>. On some implementations this
+location can be set using the C<TMPDIR> environment variable, which
+may not be secure.
+If this is a problem, simply use mkstemp() and specify a template.
+
+=over 4
+
+=item B<tmpnam>
+
+When called in scalar context, returns the full name (including path)
+of a temporary file (uses mktemp()). The only check is that the file does
+not already exist, but there is no guarantee that that condition will
+continue to apply.
+
+  $file = tmpnam();
+
+When called in list context, a filehandle to the open file and
+a filename are returned. This is achieved by calling mkstemp()
+after constructing a suitable template.
+
+  ($fh, $file) = tmpnam();
+
+If possible, this form should be used to prevent possible
+race conditions.
+
+See L<File::Spec/tmpdir> for information on the choice of temporary
+directory for a particular operating system.
+
+=cut
+
+sub tmpnam {
+
+   # Retrieve the temporary directory name
+   my $tmpdir = File::Spec->tmpdir;
+
+   croak "Error temporary directory is not writable"
+     if $tmpdir eq '';
+
+   # Use a ten character template and append to tmpdir
+   my $template = File::Spec->catfile($tmpdir, TEMPXXX);
+  
+   if (wantarray() ) {
+       return mkstemp($template);
+   } else {
+       return mktemp($template);
+   }
+
+}
+
+=item B<tmpfile>
+
+In scalar context, returns the filehandle of a temporary file.
+
+  $fh = tmpfile();
+
+The file is removed when the filehandle is closed or when the program
+exits. No access to the filename is provided.
+
+=cut
+
+sub tmpfile {
+
+  # Simply call tmpnam() in an array context
+  my ($fh, $file) = tmpnam();
+
+  # Make sure file is removed when filehandle is closed
+  unlink0($fh, $file) or croak "Unable to unlink temporary file: $!";
+
+  return $fh;
+
+}
+
+=back
+
+=head1 ADDITIONAL FUNCTIONS
+
+These functions are provided for backwards compatibility
+with common tempfile generation C library functions.
+
+They are not exported and must be addressed using the full package
+name. 
+
+=over 4
+
+=item B<tempnam>
+
+Return the name of a temporary file in the specified directory
+using a prefix. The file is guaranteed not to exist at the time
+the function was called, but such guarantees are good for one 
+clock tick only.  Always use the proper form of C<sysopen>
+with C<O_CREAT | O_EXCL> if you must open such a filename.
+
+  $filename = File::Temp::tempnam( $dir, $prefix );
+
+Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
+(using unix file convention as an example) 
+
+Because this function uses mktemp(), it can suffer from race conditions.
+
+=cut
+
+sub tempnam {
+
+  croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
+
+  my ($dir, $prefix) = @_;
+
+  # Add a string to the prefix
+  $prefix .= 'XXXXXXXX';
+
+  # Concatenate the directory to the file
+  my $template = File::Spec->catfile($dir, $prefix);
+
+  return mktemp($template);
+
+}
+
+=back
+
+=head1 UTILITY FUNCTIONS
+
+Useful functions for dealing with the filehandle and filename.
+
+=over 4
+
+=item B<unlink0>
+
+Given an open filehandle and the associated filename, make a safe
+unlink. This is achieved by first checking that the filename and
+filehandle initially point to the same file and that the number of
+links to the file is 1 (all fields returned by stat() are compared).
+Then the filename is unlinked and the filehandle checked once again to
+verify that the number of links on that file is now 0.  This is the
+closest you can come to making sure that the filename unlinked was the
+same as the file whose descriptor you hold.
+
+  unlink0($fh, $path) or die "Error unlinking file $path safely";
+
+Returns false on error. The filehandle is not closed since on some
+occasions this is not required.
+
+On some platforms, for example Windows NT, it is not possible to
+unlink an open file (the file must be closed first). On those
+platforms, the actual unlinking is deferred until the program ends
+and good status is returned. A check is still performed to make sure that
+the filehandle and filename are pointing to the same thing (but not at the time 
+the end block is executed since the deferred removal may not have access to
+the filehandle). 
+
+Additionally, on Windows NT not all the fields returned by stat() can
+be compared. For example, the C<dev> and C<rdev> fields seem to be different
+and also. Also, it seems that the size of the file returned by stat()
+does not always agree, with C<stat(FH)> being more accurate than
+C<stat(filename)>, presumably because of caching issues even when
+using autoflush (this is usually overcome by waiting a while after
+writing to the tempfile before attempting to C<unlink0> it).
+
+=cut
+
+sub unlink0 {
+
+  croak 'Usage: unlink0(filehandle, filename)'
+    unless scalar(@_) == 2;
+
+  # Read args
+  my ($fh, $path) = @_;
+
+  warn "Unlinking $path using unlink0\n"
+    if $DEBUG;
+
+  # Stat the filehandle
+  my @fh = stat $fh;
+
+  if ($fh[3] > 1 && $^W) {
+    carp "unlink0: fstat found too many links; SB=@fh";
+  } 
+
+  # Stat the path
+  my @path = stat $path;
+
+  unless (@path) {
+    carp "unlink0: $path is gone already" if $^W;
+    return;
+  } 
+
+  # this is no longer a file, but may be a directory, or worse
+  unless (-f _) {
+    confess "panic: $path is no longer a file: SB=@fh";
+  } 
+
+  # Do comparison of each member of the array
+  # On WinNT dev and rdev seem to be different
+  # depending on whether it is a file or a handle.
+  # Cannot simply compare all members of the stat return
+  # Select the ones we can use
+  my @okstat = (0..$#fh);  # Use all by default
+  if ($^O eq 'MSWin32') {
+    @okstat = (1,2,3,4,5,7,8,9,10);
+  }
+
+  # Now compare each entry explicitly by number
+  for (@okstat) {
+    print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
+    unless ($fh[$_] == $path[$_]) {
+      warn "Did not match $_ element of stat\n" if $DEBUG;
+      return 0;
+    }
+  }
+  
+  # attempt remove the file (does not work on some platforms)
+  if (_can_unlink_opened_file()) {
+    # XXX: do *not* call this on a directory; possible race
+    #      resulting in recursive removal
+    croak "unlink0: $path has become a directory!" if -d $path;
+    unlink($path) or return 0;
+
+    # Stat the filehandle
+    @fh = stat $fh;
+
+    print "Link count = $fh[3] \n" if $DEBUG;
+
+    # Make sure that the link count is zero
+    return ( $fh[3] == 0 ? 1 : 0);
+
+  } else {
+    _deferred_unlink($fh, $path, 0);
+    return 1;
+  }
+
+}
+
+=back
+
+=head1 PACKAGE VARIABLES
+
+These functions control the global state of the package.
+
+=over 4
+
+=item B<safe_level>
+
+Controls the lengths to which the module will go to check the safety of the
+temporary file or directory before proceeding.
+Options are:
+
+=over 8
+
+=item STANDARD
+
+Do the basic security measures to ensure the directory exists and
+is writable, that the umask() is fixed before opening of the file,
+that temporary files are opened only if they do not already exist, and
+that possible race conditions are avoided.  Finally the L<unlink0|"unlink0">
+function is used to remove files safely.
+
+=item MEDIUM
+
+In addition to the STANDARD security, the output directory is checked
+to make sure that it is owned either by root or the user running the
+program. If the directory is writable by group or by other, it is then
+checked to make sure that the sticky bit is set.
+
+Will not work on platforms that do not support the C<-k> test
+for sticky bit.
+
+=item HIGH
+
+In addition to the MEDIUM security checks, also check for the
+possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
+sysconf() function. If this is a possibility, each directory in the
+path is checked in turn for safeness, recursively walking back to the 
+root directory.
+
+For platforms that do not support the L<POSIX|POSIX>
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is 
+assumed that ``chown() giveaway'' is possible and the recursive test
+is performed.
+
+=back
+
+The level can be changed as follows:
+
+  File::Temp->safe_level( File::Temp::HIGH );
+
+The level constants are not exported by the module.
+
+Currently, you must be running at least perl v5.6.0 in order to
+run with MEDIUM or HIGH security. This is simply because the 
+safety tests use functions from L<Fcntl|Fcntl> that are not
+available in older versions of perl. The problem is that the version
+number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
+they are different versions.....
+
+=cut
+
+{
+  # protect from using the variable itself
+  my $LEVEL = STANDARD;
+  sub safe_level {
+    my $self = shift;
+    if (@_) { 
+      my $level = shift;
+      if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
+	carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n";
+      } else {
+	if ($] < 5.006 && $level != STANDARD) {
+	  # Cant do MEDIUM or HIGH checks
+	  croak "Currently requires perl 5.006 or newer to do the safe checks";
+	}
+        $LEVEL = $level; 
+      }
+    }
+    return $LEVEL;
+  }
+}
+
+=item TopSystemUID
+
+This is the highest UID on the current system that refers to a root
+UID. This is used to make sure that the temporary directory is 
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than 
+simply by root.
+
+This is required since on many unix systems C</tmp> is not owned
+by root.
+
+Default is to assume that any UID less than or equal to 10 is a root
+UID.
+
+  File::Temp->top_system_uid(10);
+  my $topid = File::Temp->top_system_uid;
+
+This value can be adjusted to reduce security checking if required.
+The value is only relevant when C<safe_level> is set to MEDIUM or higher.
+
+=back
+
+=cut
+
+{
+  my $TopSystemUID = 10;
+  sub top_system_uid {
+    my $self = shift;
+    if (@_) {
+      my $newuid = shift;
+      croak "top_system_uid: UIDs should be numeric"
+        unless $newuid =~ /^\d+$/s;
+      $TopSystemUID = $newuid;
+    }
+    return $TopSystemUID;
+  }
+}
+
+=head1 WARNING
+
+For maximum security, endeavour always to avoid ever looking at,
+touching, or even imputing the existence of the filename.  You do not
+know that that filename is connected to the same file as the handle
+you have, and attempts to check this can only trigger more race
+conditions.  It's far more secure to use the filehandle alone and
+dispense with the filename altogether.
+
+If you need to pass the handle to something that expects a filename
+then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
+programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
+programs.  You will have to clear the close-on-exec bit on that file
+descriptor before passing it to another process.
+
+    use Fcntl qw/F_SETFD F_GETFD/;
+    fcntl($tmpfh, F_SETFD, 0)
+        or die "Can't clear close-on-exec flag on temp fh: $!\n";
+
+=head1 HISTORY
+
+Originally began life in May 1999 as an XS interface to the system
+mkstemp() function. In March 2000, the mkstemp() code was
+translated to Perl for total control of the code's
+security checking, to ensure the presence of the function regardless of
+operating system and to help with portability.
+
+=head1 SEE ALSO
+
+L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
+
+See L<File::MkTemp> for a different implementation of temporary
+file handling.
+
+=head1 AUTHOR
+
+Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
+
+Copyright (C) 1999, 2000 Tim Jenness and the UK Particle Physics and
+Astronomy Research Council. All Rights Reserved.  This program is free
+software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+Original Perl implementation loosely based on the OpenBSD C code for 
+mkstemp(). Thanks to Tom Christiansen for suggesting that this module
+should be written and providing ideas for code improvements and
+security enhancements.
+
+=cut
+
+
+1;