line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Enbld::Home; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
957
|
use strict; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
131
|
|
4
|
4
|
|
|
4
|
|
13
|
use warnings; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
80
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
14
|
use Carp; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
254
|
|
7
|
4
|
|
|
4
|
|
19
|
use File::Spec; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
87
|
|
8
|
4
|
|
|
4
|
|
14
|
use File::Path qw/make_path remove_tree/; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
183
|
|
9
|
4
|
|
|
4
|
|
15
|
use autodie; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
26
|
|
10
|
4
|
|
|
4
|
|
20169
|
use Time::Piece; |
|
4
|
|
|
|
|
31226
|
|
|
4
|
|
|
|
|
26
|
|
11
|
4
|
|
|
4
|
|
332
|
use Time::Seconds; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
3419
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require Enbld::Feature; |
14
|
|
|
|
|
|
|
require Enbld::Error; |
15
|
|
|
|
|
|
|
require Enbld::Exception; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $dirs = { |
18
|
|
|
|
|
|
|
home => undef, |
19
|
|
|
|
|
|
|
dists => undef, |
20
|
|
|
|
|
|
|
depository => undef, |
21
|
|
|
|
|
|
|
build => undef, |
22
|
|
|
|
|
|
|
conf => undef, |
23
|
|
|
|
|
|
|
log => undef, |
24
|
|
|
|
|
|
|
etc => undef, |
25
|
|
|
|
|
|
|
extlib => undef, |
26
|
|
|
|
|
|
|
library => undef, |
27
|
|
|
|
|
|
|
deploy_path => undef, |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub initialize { |
31
|
36
|
|
|
36
|
0
|
16834
|
my $pkg = shift; |
32
|
|
|
|
|
|
|
|
33
|
36
|
|
|
|
|
181
|
$pkg->_create_home_directory; |
34
|
36
|
100
|
|
|
|
210
|
$pkg->_set_deploy_directory if Enbld::Feature->is_deploy_mode; |
35
|
36
|
|
|
|
|
139
|
$pkg->_delete_old_build_directory; |
36
|
|
|
|
|
|
|
|
37
|
36
|
|
|
|
|
146
|
return $dirs->{home}; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub AUTOLOAD { |
41
|
666
|
|
|
666
|
|
2894
|
my $method = our $AUTOLOAD; |
42
|
666
|
|
|
|
|
2860
|
$method =~ s/.*:://; |
43
|
|
|
|
|
|
|
|
44
|
666
|
100
|
|
|
|
1756
|
unless ( exists $dirs->{$method} ) { |
45
|
1
|
|
|
|
|
11
|
my $err = "Can't execute Enbld::Home's method."; |
46
|
1
|
|
|
|
|
8
|
Enbld::Exception->throw( $err, $method ); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
665
|
100
|
|
|
|
1583
|
unless ( $dirs->{$method} ) { |
50
|
1
|
|
|
|
|
1
|
my $err = "Not initialized Enbld home's path yet."; |
51
|
1
|
|
|
|
|
3
|
Enbld::Exception->throw( $err ); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
664
|
|
|
|
|
5115
|
return $dirs->{$method}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub create_build_directory { |
58
|
|
|
|
|
|
|
|
59
|
29
|
|
|
29
|
0
|
4093
|
make_path( $dirs->{build} = File::Spec->catdir( |
60
|
|
|
|
|
|
|
$dirs->{home}, 'build', time |
61
|
|
|
|
|
|
|
)); |
62
|
|
|
|
|
|
|
|
63
|
29
|
|
|
|
|
114
|
return $dirs->{build}; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub install_path { |
67
|
|
|
|
|
|
|
|
68
|
48
|
100
|
|
48
|
0
|
340
|
return Enbld::Home->deploy_path if Enbld::Feature->is_deploy_mode; |
69
|
45
|
|
|
|
|
338
|
return Enbld::Home->home; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _create_home_directory { |
74
|
36
|
|
|
36
|
|
76
|
my $pkg = shift; |
75
|
|
|
|
|
|
|
|
76
|
36
|
100
|
|
|
|
253
|
$dirs->{home} = $ENV{PERL_ENBLD_HOME} ? $ENV{PERL_ENBLD_HOME} : |
77
|
|
|
|
|
|
|
File::Spec->catdir( $ENV{HOME}, '.enbld' ); |
78
|
|
|
|
|
|
|
|
79
|
36
|
|
|
|
|
75
|
my $error; |
80
|
36
|
|
|
|
|
6176
|
make_path( $dirs->{home}, { error => \$error } ); |
81
|
|
|
|
|
|
|
|
82
|
36
|
50
|
|
|
|
100
|
if ( @{ $error } ) { |
|
36
|
|
|
|
|
151
|
|
83
|
0
|
|
|
|
|
0
|
Enbld::Error->throw( |
84
|
|
|
|
|
|
|
"Can't create Enbld's home directory:$dirs->{home}\n" . |
85
|
|
|
|
|
|
|
"Please check write permission for $dirs->{home}", |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
36
|
50
|
|
|
|
553
|
if ( ! -w $dirs->{home} ) { |
90
|
0
|
|
|
|
|
0
|
Enbld::Error->throw( |
91
|
|
|
|
|
|
|
"No permission to write directory:$dirs->{home}" . |
92
|
|
|
|
|
|
|
"Please check write permission for $dirs->{home}" |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
36
|
|
|
|
|
28997
|
make_path( $dirs->{$_} = File::Spec->catdir( $dirs->{home}, $_ )) for |
97
|
|
|
|
|
|
|
qw/dists build depository conf etc log extlib/; |
98
|
|
|
|
|
|
|
|
99
|
36
|
|
|
|
|
138
|
$dirs->{library} = $dirs->{home}; |
100
|
|
|
|
|
|
|
|
101
|
36
|
|
|
|
|
87
|
return $dirs->{home}; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _set_deploy_directory { |
105
|
|
|
|
|
|
|
|
106
|
4
|
|
|
4
|
|
59
|
my $deploy_path = Enbld::Feature->deploy_path; |
107
|
|
|
|
|
|
|
|
108
|
4
|
|
|
|
|
11
|
$dirs->{deploy_path} = $deploy_path; |
109
|
4
|
|
|
|
|
17
|
$dirs->{library} = $deploy_path; |
110
|
|
|
|
|
|
|
|
111
|
4
|
|
|
|
|
791
|
return $dirs->{deploy_path}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _delete_old_build_directory { |
115
|
|
|
|
|
|
|
|
116
|
36
|
|
|
36
|
|
305
|
opendir my $dh, $dirs->{build}; |
117
|
36
|
|
|
|
|
7472
|
my @list = grep { !/^\.{1,2}$/ } readdir $dh; |
|
75
|
|
|
|
|
415
|
|
118
|
36
|
|
|
|
|
163
|
closedir $dh; |
119
|
|
|
|
|
|
|
|
120
|
36
|
|
|
|
|
3291
|
my $limit = localtime; |
121
|
36
|
|
|
|
|
4071
|
$limit -= ONE_MONTH; |
122
|
|
|
|
|
|
|
|
123
|
36
|
|
|
|
|
2230
|
foreach my $build_dir ( @list ) { |
124
|
3
|
100
|
|
|
|
19
|
next if ( $build_dir !~ /\d{10}/ ); # for skip .DS_Store |
125
|
|
|
|
|
|
|
|
126
|
2
|
100
|
|
|
|
5
|
if ( $limit->epoch > $build_dir ) { |
127
|
1
|
|
|
|
|
310
|
remove_tree( File::Spec->catdir( $dirs->{build}, $build_dir ) ); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
0
|
|
|
sub DESTROY { |
133
|
|
|
|
|
|
|
# do nothing. |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
1; |