File Coverage

blib/lib/File/Util/Tempdir.pm
Criterion Covered Total %
statement 28 35 80.0
branch 16 26 61.5
condition 7 9 77.7
subroutine 5 5 100.0
pod 2 2 100.0
total 58 77 75.3


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.033'; # VERSION
5              
6 1     1   77162 use strict;
  1         11  
  1         24  
7 1     1   4 use warnings;
  1         2  
  1         25  
8              
9 1     1   4 use Exporter qw(import);
  1         1  
  1         325  
10             our @EXPORT_OK = qw(get_tempdir get_user_tempdir);
11              
12             sub get_tempdir {
13 6 50   6 1 984 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 6         64 for (qw/TMPDIR TEMPDIR TMP TEMP/) {
22 12 100       36 return $ENV{$_} if defined $ENV{$_};
23             }
24 2         3 for ("/tmp", "/var/tmp") {
25 2 50       63 return $_ if -d;
26             }
27             }
28 0         0 die "Can't find any temporary directory";
29             }
30              
31             sub get_user_tempdir {
32 9 50   9 1 15266 if ($^O eq 'MSWin32') {
33 0         0 return get_tempdir();
34             } else {
35             my $dir = $ENV{XDG_RUNTIME_DIR} ?
36 9 100       26 $ENV{XDG_RUNTIME_DIR} : get_tempdir();
37 9         149 my @st = stat($dir);
38 9 50       30 die "Can't stat tempdir '$dir': $!" unless @st;
39 9 100 100     80 return $dir if $st[4] == $> && !($st[2] & 022);
40 7         14 my $i = 0;
41 7         9 while (1) {
42 11 100       178 my $subdir = "$dir/$>" . ($i ? ".$i" : "");
43 11         246 my @stsub = stat($subdir);
44 11         28 my $is_dir = -d _;
45 11 100 66     55 if (!@stsub) {
    50 66        
46 7 50       302 mkdir $subdir, 0700 or die "Can't mkdir '$subdir': $!";
47 7         95 return $subdir;
48             } elsif ($is_dir && $stsub[4] == $> && !($stsub[2] & 022)) {
49 0         0 return $subdir;
50             } else {
51 4         12 $i++;
52             }
53             }
54             }
55             }
56              
57             1;
58             # ABSTRACT: Cross-platform way to get system-wide & user private temporary directory
59              
60             __END__