File Coverage

blib/lib/File/Util/Tempdir.pm
Criterion Covered Total %
statement 19 35 54.2
branch 7 26 26.9
condition 0 3 0.0
subroutine 5 5 100.0
pod 2 2 100.0
total 33 71 46.4


line stmt bran cond sub pod time code
1             package File::Util::Tempdir;
2              
3             our $DATE = '2018-09-20'; # DATE
4             our $VERSION = '0.031'; # VERSION
5              
6 1     1   70341 use strict;
  1         14  
  1         29  
7 1     1   5 use warnings;
  1         2  
  1         27  
8              
9 1     1   6 use Exporter qw(import);
  1         2  
  1         454  
10             our @EXPORT_OK = qw(get_tempdir get_user_tempdir);
11              
12             sub get_tempdir {
13 2 50   2 1 1262 if ($^O eq 'MSWin32') {
14 0         0 for (qw/TMP TEMP TMPDIR TEMPDIR/) {
15 0 0       0 return $ENV{$_} if defined $ENV{$_};
16             }
17 0         0 for ("C:\\TMP", "C:\\TEMP") {
18 0 0       0 return $_ if -d;
19             }
20             } else {
21 2         6 for (qw/TMPDIR TEMPDIR TMP TEMP/) {
22 8 50       19 return $ENV{$_} if defined $ENV{$_};
23             }
24 2         5 for ("/tmp", "/var/tmp") {
25 2 50       83 return $_ if -d;
26             }
27             }
28 0         0 die "Can't find any temporary directory";
29             }
30              
31             sub get_user_tempdir {
32 1 50   1 1 2857 if ($^O eq 'MSWin32') {
33 0         0 return get_tempdir();
34             } else {
35             my $dir = $ENV{XDG_RUNTIME_DIR} ?
36 1 50       5 $ENV{XDG_RUNTIME_DIR} : get_tempdir();
37 1         13 my @st = stat($dir);
38 1 50       6 die "Can't stat tempdir '$dir': $!" if $!;
39 1 50       15 return $dir if $st[4] == $>;
40 0           my $i = 0;
41 0           while (1) {
42 0 0         my $subdir = "$dir/$>" . ($i ? ".$i" : "");
43 0           my @stsub = stat($subdir);
44 0           my $is_dir = -d _;
45 0 0 0       if (!@stsub) {
    0          
46 0 0         mkdir $subdir, 0700 or die "Can't mkdir '$subdir': $!";
47 0           return $subdir;
48             } elsif ($is_dir && $stsub[4] == $>) {
49 0           return $subdir;
50             } else {
51 0           $i++;
52             }
53             }
54             }
55             }
56              
57             1;
58             # ABSTRACT: Cross-platform way to get system-wide & user private temporary directory
59              
60             __END__