line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package File::HomeDir::Test; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
55998
|
use 5.008003; |
|
1
|
|
|
|
|
10
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
6
|
1
|
|
|
1
|
|
3
|
use Carp (); |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
20
|
|
7
|
1
|
|
|
1
|
|
4
|
use File::Spec (); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
10
|
|
8
|
1
|
|
|
1
|
|
600
|
use File::Temp (); |
|
1
|
|
|
|
|
16640
|
|
|
1
|
|
|
|
|
20
|
|
9
|
1
|
|
|
1
|
|
315
|
use File::HomeDir::Driver (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
5
|
use vars qw{$VERSION %DIR $ENABLED}; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
12
|
1
|
|
|
1
|
|
4
|
use base "File::HomeDir::Driver"; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
128
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
BEGIN |
15
|
|
|
|
|
|
|
{ |
16
|
1
|
|
|
1
|
|
3
|
$VERSION = '1.003_002'; |
17
|
1
|
|
|
|
|
2
|
%DIR = (); |
18
|
1
|
|
|
|
|
343
|
$ENABLED = 0; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Special magic use in test scripts |
22
|
|
|
|
|
|
|
sub import |
23
|
|
|
|
|
|
|
{ |
24
|
1
|
|
|
1
|
|
6
|
my $class = shift; |
25
|
1
|
50
|
|
|
|
3
|
Carp::croak "Attempted to initialise File::HomeDir::Test trice" if %DIR; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Fill the test directories |
28
|
1
|
|
|
|
|
3
|
my $BASE = File::Temp::tempdir(CLEANUP => 1); |
29
|
1
|
|
|
|
|
542
|
%DIR = map { $_ => File::Spec->catdir($BASE, $_) } qw{ |
|
7
|
|
|
|
|
44
|
|
30
|
|
|
|
|
|
|
my_home |
31
|
|
|
|
|
|
|
my_desktop |
32
|
|
|
|
|
|
|
my_documents |
33
|
|
|
|
|
|
|
my_data |
34
|
|
|
|
|
|
|
my_music |
35
|
|
|
|
|
|
|
my_pictures |
36
|
|
|
|
|
|
|
my_videos |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Hijack HOME to the home directory |
40
|
1
|
|
|
|
|
6
|
$ENV{HOME} = $DIR{my_home}; ## no critic qw(LocalizedPunctuationVars) |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Make File::HomeDir load us instead of the native driver |
43
|
1
|
|
|
|
|
2
|
$File::HomeDir::IMPLEMENTED_BY = # Prevent a warning |
44
|
|
|
|
|
|
|
$File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Test'; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Ready to go |
47
|
1
|
|
|
|
|
23
|
$ENABLED = 1; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
##################################################################### |
51
|
|
|
|
|
|
|
# Current User Methods |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub my_home |
54
|
|
|
|
|
|
|
{ |
55
|
1
|
50
|
|
1
|
0
|
75
|
mkdir($DIR{my_home}, oct(755)) unless -d $DIR{my_home}; |
56
|
1
|
|
|
|
|
6
|
return $DIR{my_home}; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub my_desktop |
60
|
|
|
|
|
|
|
{ |
61
|
1
|
50
|
|
1
|
0
|
50
|
mkdir($DIR{my_desktop}, oct(755)) unless -d $DIR{my_desktop}; |
62
|
1
|
|
|
|
|
6
|
return $DIR{my_desktop}; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub my_documents |
66
|
|
|
|
|
|
|
{ |
67
|
1
|
50
|
|
1
|
0
|
48
|
mkdir($DIR{my_documents}, oct(755)) unless -f $DIR{my_documents}; |
68
|
1
|
|
|
|
|
6
|
return $DIR{my_documents}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub my_data |
72
|
|
|
|
|
|
|
{ |
73
|
1
|
50
|
|
1
|
0
|
48
|
mkdir($DIR{my_data}, oct(755)) unless -d $DIR{my_data}; |
74
|
1
|
|
|
|
|
5
|
return $DIR{my_data}; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub my_music |
78
|
|
|
|
|
|
|
{ |
79
|
1
|
50
|
|
1
|
0
|
48
|
mkdir($DIR{my_music}, oct(755)) unless -d $DIR{my_music}; |
80
|
1
|
|
|
|
|
5
|
return $DIR{my_music}; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub my_pictures |
84
|
|
|
|
|
|
|
{ |
85
|
1
|
50
|
|
1
|
0
|
48
|
mkdir($DIR{my_pictures}, oct(755)) unless -d $DIR{my_pictures}; |
86
|
1
|
|
|
|
|
5
|
return $DIR{my_pictures}; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub my_videos |
90
|
|
|
|
|
|
|
{ |
91
|
1
|
50
|
|
1
|
0
|
54
|
mkdir($DIR{my_videos}, oct(755)) unless -d $DIR{my_videos}; |
92
|
1
|
|
|
|
|
6
|
return $DIR{my_videos}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub users_home |
96
|
|
|
|
|
|
|
{ |
97
|
0
|
|
|
0
|
0
|
|
return undef; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
1; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
__END__ |