line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pcore::Core::Env; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
31
|
use Pcore -class; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
30
|
|
4
|
5
|
|
|
5
|
|
873
|
use Config; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
1056
|
|
5
|
5
|
|
|
5
|
|
966
|
use File::Spec qw[]; ## no critic qw[Modules::ProhibitEvilModules] needed to find system temp dir |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
74
|
|
6
|
5
|
|
|
5
|
|
17
|
use Cwd qw[]; ## no critic qw[Modules::ProhibitEvilModules] |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
67
|
|
7
|
5
|
|
|
5
|
|
1535
|
use Pcore::Dist; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
163
|
|
8
|
5
|
|
|
5
|
|
2119
|
use Pcore::Core::Env::Share; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
211
|
|
9
|
5
|
|
|
5
|
|
40
|
use Fcntl qw[LOCK_EX SEEK_SET]; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
13020
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
has is_par => ( is => 'lazy', isa => Bool, init_arg => undef ); # process run from PAR distribution |
12
|
|
|
|
|
|
|
has _main_dist => ( is => 'lazy', isa => Maybe [ InstanceOf ['Pcore::Dist'] ], init_arg => undef ); # main dist |
13
|
|
|
|
|
|
|
has pcore => ( is => 'lazy', isa => InstanceOf ['Pcore::Dist'], init_arg => undef ); # pcore dist |
14
|
|
|
|
|
|
|
has share => ( is => 'lazy', isa => InstanceOf ['Pcore::Core::Env::Share'], init_arg => undef ); # share object |
15
|
|
|
|
|
|
|
has _dist_idx => ( is => 'lazy', isa => HashRef, default => sub { {} }, init_arg => undef ); # registered dists. index |
16
|
|
|
|
|
|
|
has cli => ( is => 'ro', isa => HashRef, init_arg => undef ); # parsed CLI data |
17
|
|
|
|
|
|
|
has user_cfg_path => ( is => 'lazy', isa => Str, init_arg => undef ); |
18
|
|
|
|
|
|
|
has user_cfg => ( is => 'lazy', isa => HashRef, init_arg => undef ); # $HOME/.pcore/pcore.ini config |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
has can_scan_deps => ( is => 'lazy', isa => Bool, init_arg => undef ); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
_normalize_inc(); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# create $ENV object |
25
|
|
|
|
|
|
|
$ENV = __PACKAGE__->new; ## no critic qw[Variables::RequireLocalizedPunctuationVars] |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
$ENV->_INIT; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
_configure_inc(); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub _normalize_inc { |
32
|
5
|
|
|
5
|
|
11
|
my @inc; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $inc_index; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# index @INC, resolve @INC paths, remove duplicates, preserve REF items |
37
|
5
|
|
|
|
|
14
|
for my $inc_path (@INC) { |
38
|
50
|
50
|
|
|
|
102
|
if ( ref $inc_path ) { |
39
|
0
|
|
|
|
|
0
|
push @inc, $inc_path; |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
0
|
next; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# ignore non-exists path |
45
|
50
|
50
|
|
|
|
664
|
next if !-d $inc_path; |
46
|
|
|
|
|
|
|
|
47
|
50
|
|
|
|
|
838
|
$inc_path = P->path( $inc_path, is_dir => 1 )->realpath->canonpath; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# ignore already added path |
50
|
50
|
100
|
|
|
|
484
|
if ( !exists $inc_index->{$inc_path} ) { |
51
|
40
|
|
|
|
|
90
|
$inc_index->{$inc_path} = 1; |
52
|
|
|
|
|
|
|
|
53
|
40
|
|
|
|
|
94
|
push @inc, $inc_path; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
5
|
|
|
|
|
30
|
@INC = @inc; ## no critic qw[Variables::RequireLocalizedPunctuationVars] |
58
|
|
|
|
|
|
|
|
59
|
5
|
|
|
|
|
21
|
return; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _configure_inc { |
63
|
5
|
|
|
5
|
|
10
|
my @inc; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $inc_index; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# index @INC, resolve @INC paths, remove duplicates, preserve REF items |
68
|
5
|
|
|
|
|
16
|
for my $inc_path (@INC) { |
69
|
40
|
50
|
|
|
|
71
|
if ( ref $inc_path ) { |
70
|
0
|
|
|
|
|
0
|
push @inc, $inc_path; |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
0
|
next; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# ignore already added path |
76
|
40
|
50
|
|
|
|
69
|
if ( !exists $inc_index->{$inc_path} ) { |
77
|
40
|
|
|
|
|
66
|
$inc_index->{$inc_path} = 1; |
78
|
|
|
|
|
|
|
|
79
|
40
|
|
|
|
|
62
|
push @inc, $inc_path; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# not for PAR |
84
|
5
|
50
|
|
|
|
84
|
if ( !$ENV->is_par ) { |
85
|
5
|
|
|
|
|
43
|
my $is_module_build_test = 0; # $ENV->dist && exists $inc_index->{ $ENV->dist->root . 'blib/lib' } ? 1 : 0; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# add dist lib and PCORE_LIB to @INC only if we are int on the PAR archive and not in the Module::Build testing environment |
88
|
|
|
|
|
|
|
# under Module::Build dist lib is already added and PCORE_LIB is not added to emulate clean CPAN installation |
89
|
5
|
50
|
|
|
|
16
|
if ( !$is_module_build_test ) { |
90
|
5
|
|
|
|
|
9
|
my $dist_lib_path; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# detect dist lib path |
93
|
5
|
50
|
33
|
|
|
13
|
if ( $ENV->dist && !exists $inc_index->{ $ENV->dist->root . 'lib' } && -d $ENV->dist->root . 'lib/' ) { |
|
|
|
33
|
|
|
|
|
94
|
5
|
|
|
|
|
152
|
$dist_lib_path = $ENV->dist->root . 'lib'; |
95
|
|
|
|
|
|
|
|
96
|
5
|
|
|
|
|
52
|
$inc_index->{$dist_lib_path} = 1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# find and add other dist libs to @INC |
100
|
5
|
50
|
33
|
|
|
25
|
if ( $ENV{PCORE_LIB} && -d $ENV{PCORE_LIB} ) { |
101
|
0
|
|
|
|
|
0
|
for my $dir ( sort { $b cmp $a } P->file->read_dir( $ENV{PCORE_LIB}, full_path => 1 )->@* ) { |
|
0
|
|
|
|
|
0
|
|
102
|
0
|
0
|
0
|
|
|
0
|
if ( !exists $inc_index->{qq[$dir/lib]} && -d qq[$dir/lib/] && Pcore::Dist->dir_is_dist_root($dir) ) { |
|
|
|
0
|
|
|
|
|
103
|
0
|
|
|
|
|
0
|
$inc_index->{qq[$dir/lib]} = 1; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
unshift @inc, qq[$dir/lib]; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# register dist lib path in @INC, dist lib path is always on top of other dists |
111
|
5
|
50
|
|
|
|
35
|
unshift @inc, $dist_lib_path if $dist_lib_path; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
5
|
|
|
|
|
38
|
@INC = @inc; ## no critic qw[Variables::RequireLocalizedPunctuationVars] |
116
|
|
|
|
|
|
|
|
117
|
5
|
|
|
|
|
38
|
return; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
5
|
|
|
5
|
|
10
|
sub _INIT ($self) { |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
11
|
|
121
|
5
|
|
|
|
|
56
|
$self->{START_DIR} = P->file->cwd->to_string; |
122
|
|
|
|
|
|
|
|
123
|
5
|
50
|
33
|
|
|
40
|
if ( $Pcore::SCRIPT_PATH eq '-e' || $Pcore::SCRIPT_PATH eq '-' ) { |
124
|
0
|
|
|
|
|
0
|
$self->{SCRIPT_NAME} = '-e'; |
125
|
0
|
|
|
|
|
0
|
$self->{SCRIPT_DIR} = $self->{START_DIR}; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
else { |
128
|
5
|
50
|
|
|
|
117
|
die qq[Cannot find current script "$Pcore::SCRIPT_PATH"] if !-f $Pcore::SCRIPT_PATH; |
129
|
|
|
|
|
|
|
|
130
|
5
|
|
|
|
|
92
|
my $path = P->path($Pcore::SCRIPT_PATH)->realpath; |
131
|
|
|
|
|
|
|
|
132
|
5
|
|
|
|
|
102
|
$self->{SCRIPT_NAME} = $path->filename; |
133
|
5
|
|
|
|
|
112
|
$self->{SCRIPT_DIR} = $path->dirname; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
5
|
|
|
|
|
57
|
$self->{SCRIPT_PATH} = $self->{SCRIPT_DIR} . $self->{SCRIPT_NAME}; |
137
|
|
|
|
|
|
|
|
138
|
5
|
|
|
|
|
193
|
$self->{SYS_TEMP_DIR} = P->path( File::Spec->tmpdir, is_dir => 1 )->to_string; |
139
|
5
|
|
|
|
|
127
|
$self->{TEMP_DIR} = P->file->tempdir( base => $self->{SYS_TEMP_DIR}, lazy => 1 ); |
140
|
5
|
|
33
|
|
|
130
|
$self->{USER_DIR} = P->path( $ENV{HOME} || $ENV{USERPROFILE}, is_dir => 1 ); |
141
|
5
|
|
|
|
|
34
|
$self->{PCORE_USER_DIR} = P->path( $self->{USER_DIR} . '.pcore/', is_dir => 1, lazy => 1 ); |
142
|
5
|
|
|
|
|
106
|
$self->{PCORE_SYS_DIR} = P->path( $self->{SYS_TEMP_DIR} . '.pcore/', is_dir => 1, lazy => 1 ); |
143
|
5
|
50
|
|
|
|
118
|
$self->{INLINE_DIR} = $self->is_par ? undef : P->path( $self->{PCORE_USER_DIR} . "inline/$Config{version}/$Config{archname}/", is_dir => 1, lazy => 1 ); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# CLI options |
146
|
5
|
|
|
|
|
21
|
$self->{SCAN_DEPS} = 0; |
147
|
5
|
|
|
|
|
14
|
$self->{DAEMONIZE} = 0; |
148
|
5
|
|
|
|
|
13
|
$self->{UID} = undef; |
149
|
5
|
|
|
|
|
14
|
$self->{GID} = undef; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# load dist.perl |
152
|
5
|
50
|
|
|
|
21
|
if ( my $dist = $self->dist ) { |
153
|
5
|
50
|
|
|
|
155
|
if ( $self->is_par ) { |
154
|
0
|
|
|
|
|
0
|
$self->{DATA_DIR} = $self->{SCRIPT_DIR}; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
else { |
157
|
5
|
|
|
|
|
161
|
$self->{DATA_DIR} = P->path( $dist->root . 'data/', is_dir => 1, lazy => 1 ); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
else { |
161
|
0
|
|
|
|
|
0
|
$self->{DATA_DIR} = $self->{START_DIR}; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# init pcore dist, needed to register pcore resources during bootstrap |
165
|
5
|
|
|
|
|
139
|
$self->pcore; |
166
|
|
|
|
|
|
|
|
167
|
5
|
|
|
|
|
142
|
return; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
5
|
|
|
5
|
|
62
|
sub _build_is_par ($self) { |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
10
|
|
171
|
5
|
50
|
|
|
|
87
|
return $ENV{PAR_TEMP} ? 1 : 0; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
5
|
|
|
5
|
|
56
|
sub _build__main_dist ($self) { |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
6
|
|
175
|
5
|
|
|
|
|
10
|
my $dist; |
176
|
|
|
|
|
|
|
|
177
|
5
|
50
|
|
|
|
81
|
if ( $self->is_par ) { |
178
|
0
|
|
|
|
|
0
|
$dist = Pcore::Dist->new( $ENV{PAR_TEMP} ); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
else { |
181
|
5
|
|
|
|
|
146
|
$dist = Pcore::Dist->new( $self->{SCRIPT_DIR} ); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
5
|
50
|
|
|
|
385
|
if ($dist) { |
185
|
5
|
|
|
|
|
14
|
$dist->{is_main} = 1; |
186
|
|
|
|
|
|
|
|
187
|
5
|
|
|
|
|
21
|
$self->register_dist($dist); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
5
|
|
|
|
|
70
|
return $dist; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
5
|
|
|
5
|
|
59
|
sub _build_pcore ($self) { |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
10
|
|
194
|
5
|
50
|
33
|
|
|
20
|
if ( $self->dist && $self->dist->is_pcore ) { |
195
|
5
|
|
|
|
|
129
|
return $self->dist; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
else { |
198
|
0
|
|
|
|
|
0
|
my $pcore = Pcore::Dist->new('Pcore.pm'); |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
0
|
$self->register_dist($pcore); |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
|
|
0
|
return $pcore; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
5
|
|
|
5
|
|
53
|
sub _build_share ($self) { |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
6
|
|
207
|
5
|
|
|
|
|
47
|
return Pcore::Core::Env::Share->new; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
|
0
|
|
0
|
sub _build_user_cfg_path ($self) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
211
|
0
|
|
|
|
|
0
|
return "$self->{PCORE_USER_DIR}pcore.ini"; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
0
|
|
0
|
sub _build_user_cfg ($self) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
215
|
0
|
0
|
|
|
|
0
|
if ( !-f $self->user_cfg_path ) { |
216
|
0
|
|
|
|
|
0
|
return {}; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
0
|
|
|
|
|
0
|
return P->cfg->load( $self->user_cfg_path ); |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
5
|
|
|
5
|
0
|
9
|
sub register_dist ( $self, $dist ) { |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
11
|
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# create dist object |
226
|
5
|
50
|
|
|
|
18
|
$dist = Pcore::Dist->new($dist) if !ref $dist; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# dist was not found |
229
|
5
|
50
|
|
|
|
14
|
die qq[Invlaid Pcore -dist pragma usage, "$dist" is not a Pcore dist main module] if !$dist; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# dist is already registered |
232
|
5
|
50
|
|
|
|
95
|
return if exists $self->_dist_idx->{ $dist->name }; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# add dist to the dists index |
235
|
5
|
|
|
|
|
243
|
$self->_dist_idx->{ $dist->name } = $dist; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# register dist share |
238
|
5
|
|
|
|
|
133
|
my $share_lib_level; |
239
|
|
|
|
|
|
|
|
240
|
5
|
50
|
|
|
|
104
|
if ( $dist->is_pcore ) { # pcore dist is always first |
|
|
0
|
|
|
|
|
|
241
|
5
|
|
|
|
|
143
|
$share_lib_level = 0; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
elsif ( $dist->is_main ) { # main dist is always on top |
244
|
0
|
|
|
|
|
0
|
$share_lib_level = 9_999; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
else { |
248
|
0
|
|
|
|
|
0
|
state $next_level = 10; |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
0
|
$share_lib_level = $next_level++; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
5
|
|
|
|
|
77
|
$self->share->add_lib( $dist->name, $dist->share_dir, $share_lib_level ); |
254
|
|
|
|
|
|
|
|
255
|
5
|
|
|
|
|
12
|
return; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
50
|
|
|
50
|
0
|
375
|
sub dist ( $self, $dist_name = undef ) { |
|
50
|
|
|
|
|
101
|
|
|
50
|
|
|
|
|
68
|
|
|
50
|
|
|
|
|
63
|
|
259
|
50
|
50
|
|
|
|
94
|
if ($dist_name) { |
260
|
0
|
|
|
|
|
0
|
return $self->_dist_idx->{ $dist_name =~ s/::/-/smgr }; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
else { |
263
|
50
|
|
|
|
|
788
|
return $self->_main_dist; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# SCAN DEPS |
268
|
5
|
|
|
5
|
|
82
|
sub _build_can_scan_deps ($self) { |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
13
|
|
269
|
5
|
|
33
|
|
|
97
|
return !$self->is_par && $self->dist && $self->dist->par_cfg && exists $self->dist->par_cfg->{ $self->{SCRIPT_NAME} }; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
0
|
|
|
0
|
0
|
|
sub scan_deps ($self) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
|
return if !$self->can_scan_deps; |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
$self->{SCAN_DEPS} = $self->dist->share_dir . "pardeps-$self->{SCRIPT_NAME}-@{[$^V->normal]}-$Config{archname}.json"; |
|
0
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# eval TypeTiny Error |
278
|
0
|
|
|
|
|
|
eval { Int->('error') }; |
|
0
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# eval common modules |
281
|
0
|
|
|
|
|
|
require Cpanel::JSON::XS; ## no critic qw[Modules::ProhibitEvilModules] |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
|
return; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
0
|
0
|
|
sub DEMOLISH ( $self, $global ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
287
|
0
|
0
|
|
|
|
|
if ( $self->{SCAN_DEPS} ) { |
288
|
0
|
|
|
|
|
|
my ( $fh, $index ); |
289
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
|
if ( -f $self->{SCAN_DEPS} ) { |
291
|
0
|
0
|
|
|
|
|
open $fh, '+<:raw', $self->{SCAN_DEPS} or die; ## no critic qw[InputOutput::RequireBriefOpen] |
292
|
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
|
flock $fh, LOCK_EX or die; |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
local $/; |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
my $deps = Cpanel::JSON::XS->new->ascii(0)->latin1(0)->utf8(1)->pretty(1)->canonical(1)->decode(<$fh>); |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
|
|
|
$index->@{ $deps->@* } = (); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
else { |
302
|
0
|
0
|
|
|
|
|
open $fh, '>:raw', $self->{SCAN_DEPS} or die; ## no critic qw[InputOutput::RequireBriefOpen] |
303
|
|
|
|
|
|
|
|
304
|
0
|
0
|
|
|
|
|
flock $fh, LOCK_EX or die; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
0
|
|
|
|
|
|
my ( $updated, $embedded_packages ); |
308
|
|
|
|
|
|
|
|
309
|
0
|
|
|
|
|
|
for my $module ( sort keys %INC ) { |
310
|
0
|
0
|
|
|
|
|
if ( !exists $index->{$module} ) { |
311
|
0
|
0
|
|
|
|
|
if ( $INC{$module} !~ /\Q$module\E\z/sm ) { |
312
|
0
|
|
|
|
|
|
$embedded_packages->{$module} = $INC{$module}; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
else { |
315
|
0
|
|
|
|
|
|
$updated = 1; |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
$index->{$module} = undef; |
318
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
say qq[new deps found: $module]; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# find real module for embedded modules |
325
|
0
|
0
|
|
|
|
|
if ($embedded_packages) { |
326
|
0
|
|
|
|
|
|
for my $embedded_package ( keys $embedded_packages->%* ) { |
327
|
0
|
|
|
|
|
|
my $added; |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
for my $module ( keys %INC ) { |
330
|
0
|
0
|
|
|
|
|
if ( $INC{$module} eq $embedded_packages->{$embedded_package} ) { |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# embedded package is already added |
333
|
0
|
0
|
|
|
|
|
if ( exists $index->{$module} ) { |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# say "$module ---> $embedded_package"; |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
|
$added = 1; |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
|
last; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
0
|
|
|
|
|
if ( !$added ) { |
345
|
0
|
|
|
|
|
|
$updated = 1; |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
$index->{$embedded_package} = undef; |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
say qq[new deps found: $embedded_package]; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# store deps |
355
|
0
|
0
|
|
|
|
|
if ($updated) { |
356
|
0
|
0
|
|
|
|
|
truncate $fh, 0 or die; |
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
|
seek $fh, 0, SEEK_SET or die; |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
print {$fh} Cpanel::JSON::XS->new->ascii(0)->latin1(0)->utf8(1)->pretty(1)->canonical(1)->encode( [ sort keys $index->%* ] ); |
|
0
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
0
|
0
|
|
|
|
|
close $fh or die; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
0
|
|
|
|
|
|
return; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
1; |
370
|
|
|
|
|
|
|
## -----SOURCE FILTER LOG BEGIN----- |
371
|
|
|
|
|
|
|
## |
372
|
|
|
|
|
|
|
## PerlCritic profile "pcore-script" policy violations: |
373
|
|
|
|
|
|
|
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+ |
374
|
|
|
|
|
|
|
## | Sev. | Lines | Policy | |
375
|
|
|
|
|
|
|
## |======+======================+================================================================================================================| |
376
|
|
|
|
|
|
|
## | 3 | 278 | ErrorHandling::RequireCheckingReturnValueOfEval - Return value of eval not tested | |
377
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
378
|
|
|
|
|
|
|
## | 3 | 286 | Subroutines::ProhibitExcessComplexity - Subroutine "DEMOLISH" with high complexity score (22) | |
379
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
380
|
|
|
|
|
|
|
## | 3 | 295 | Variables::RequireInitializationForLocalVars - "local" variable not initialized | |
381
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
382
|
|
|
|
|
|
|
## | 3 | 333 | ControlStructures::ProhibitDeepNests - Code structure is deeply nested | |
383
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
384
|
|
|
|
|
|
|
## | 2 | 297, 360 | ValuesAndExpressions::ProhibitLongChainsOfMethodCalls - Found method-call chain of length 7 | |
385
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
386
|
|
|
|
|
|
|
## | 1 | 101 | BuiltinFunctions::ProhibitReverseSortBlock - Forbid $b before $a in sort blocks | |
387
|
|
|
|
|
|
|
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+ |
388
|
|
|
|
|
|
|
## |
389
|
|
|
|
|
|
|
## -----SOURCE FILTER LOG END----- |
390
|
|
|
|
|
|
|
__END__ |
391
|
|
|
|
|
|
|
=pod |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=encoding utf8 |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head1 NAME |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Pcore::Core::Env |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=head1 SYNOPSIS |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head1 DESCRIPTION |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head1 METHODS |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head1 SEE ALSO |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=cut |