line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Devel::PerlySense::Project - A Project root |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 DESCRIPTION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
A Project describes the root directory of a source tree. |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
A Project has configuration settings. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
63
|
|
|
63
|
|
218
|
use strict; |
|
63
|
|
|
|
|
81
|
|
|
63
|
|
|
|
|
1790
|
|
23
|
63
|
|
|
63
|
|
229
|
use warnings; |
|
63
|
|
|
|
|
64
|
|
|
63
|
|
|
|
|
1571
|
|
24
|
63
|
|
|
63
|
|
1054
|
use utf8; |
|
63
|
|
|
|
|
110
|
|
|
63
|
|
|
|
|
315
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
package Devel::PerlySense::Project; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
63
|
|
|
63
|
|
2579
|
use Spiffy -Base; |
|
63
|
|
|
|
|
5096
|
|
|
63
|
|
|
|
|
285
|
|
31
|
63
|
|
|
63
|
|
158257
|
use Carp; |
|
63
|
|
|
63
|
|
76
|
|
|
63
|
|
|
63
|
|
1644
|
|
|
63
|
|
|
|
|
205
|
|
|
63
|
|
|
|
|
72
|
|
|
63
|
|
|
|
|
1624
|
|
|
63
|
|
|
|
|
220
|
|
|
63
|
|
|
|
|
62
|
|
|
63
|
|
|
|
|
3347
|
|
32
|
63
|
|
|
63
|
|
238
|
use Data::Dumper; |
|
63
|
|
|
|
|
81
|
|
|
63
|
|
|
|
|
2317
|
|
33
|
63
|
|
|
63
|
|
689
|
use File::Basename; |
|
63
|
|
|
|
|
480
|
|
|
63
|
|
|
|
|
3238
|
|
34
|
63
|
|
|
63
|
|
509
|
use Path::Class; |
|
63
|
|
|
|
|
30928
|
|
|
63
|
|
|
|
|
2350
|
|
35
|
63
|
|
|
63
|
|
32893
|
use File::Slurp; |
|
63
|
|
|
|
|
676819
|
|
|
63
|
|
|
|
|
4415
|
|
36
|
63
|
|
|
63
|
|
23352
|
use File::chdir; |
|
63
|
|
|
|
|
111527
|
|
|
63
|
|
|
|
|
6345
|
|
37
|
63
|
|
|
63
|
|
30325
|
use Perl::Critic 1.105; |
|
63
|
|
|
|
|
85117707
|
|
|
63
|
|
|
|
|
6406
|
|
38
|
63
|
|
|
63
|
|
473
|
use List::MoreUtils qw/ uniq /; |
|
63
|
|
|
|
|
83
|
|
|
63
|
|
|
|
|
3871
|
|
39
|
|
|
|
|
|
|
|
40
|
63
|
|
|
63
|
|
1949
|
use Devel::PerlySense; |
|
63
|
|
|
|
|
103
|
|
|
63
|
|
|
|
|
701
|
|
41
|
63
|
|
|
63
|
|
21755
|
use Devel::PerlySense::Util; |
|
63
|
|
|
|
|
87
|
|
|
63
|
|
|
|
|
3500
|
|
42
|
63
|
|
|
63
|
|
607
|
use Devel::PerlySense::Util::Log; |
|
63
|
|
|
|
|
120
|
|
|
63
|
|
|
|
|
2355
|
|
43
|
63
|
|
|
63
|
|
31731
|
use Devel::PerlySense::Config::Project::Default; |
|
63
|
|
|
|
|
134
|
|
|
63
|
|
|
|
|
522
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 PROPERTIES |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 dirProject |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
The effective project root dir. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Readonly. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=cut |
58
|
1964
|
|
|
1964
|
1
|
6109
|
sub dirProject { |
59
|
|
|
|
|
|
|
return |
60
|
1964
|
|
66
|
|
|
46795
|
$self->dirProjectExplicitDir || |
61
|
|
|
|
|
|
|
$self->dirProjectImplicitUse || |
62
|
|
|
|
|
|
|
$self->dirProjectImplicitDir; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 dirProjectExplicitDir |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
If known, the root dir made explicit by the existence of a project |
72
|
|
|
|
|
|
|
directory and config, else "" |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Default: "" |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
field "dirProjectExplicitDir" => ""; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head2 dirProjectImplicitUse |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
If known, the root dir indicated by a found used module, else "". |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Default: "" |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
field "dirProjectImplicitUse" => ""; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 dirProjectImplicitDir |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
If known, the root dir indicated by the presence of "lib" or "t", else "". |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Default: "" |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
field "dirProjectImplicitDir" => ""; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 oConfig |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
A Config::Project object with the current Project Config. This gets |
112
|
|
|
|
|
|
|
loaded if there is a config file available when the Project is |
113
|
|
|
|
|
|
|
identified. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Default: An Config::Project::Default object |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=cut |
118
|
|
|
|
|
|
|
field "oConfig" => Devel::PerlySense::Config::Project::Default->new(); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 rhConfig |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
The actual hashref with config values. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Readonly (that includes the entire data structure). |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
1300
|
|
|
1300
|
1
|
5052
|
sub rhConfig { |
132
|
1300
|
|
|
|
|
36701
|
return $self->oConfig->rhConfig; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 oPerlySense |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Devel::PerlySense object. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
field "oPerlySense" => undef; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 nameVcs |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
The name of the Version Control system for the project. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Readonly. Currently supported: |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
git |
157
|
|
|
|
|
|
|
svn |
158
|
|
|
|
|
|
|
none |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
In that order, so that if there's a Git repo on top of a SVN repo, git |
161
|
|
|
|
|
|
|
is found. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
1
|
|
|
1
|
1
|
1
|
sub nameVcs { |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
#Git |
167
|
1
|
50
|
|
|
|
23
|
$self->oPerlySense->dirFindLookingAround( |
168
|
|
|
|
|
|
|
".git", |
169
|
|
|
|
|
|
|
$self->dirProject, |
170
|
|
|
|
|
|
|
["."], |
171
|
|
|
|
|
|
|
) and return("git"); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
#Subversion |
174
|
0
|
0
|
|
|
|
0
|
-d dir($self->dirProject, ".svn") and return("svn"); |
175
|
|
|
|
|
|
|
|
176
|
0
|
|
|
|
|
0
|
return("none"); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 CLASS METHODS |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 newFromLocation(file => $file, dir => $dir, oPerlySense => $oPs) |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Create new Project given either $file, or $dir. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
First, search for an explicit project root directory, then try to find |
190
|
|
|
|
|
|
|
any modules used in $file (if passed), then try to find any "lib" or |
191
|
|
|
|
|
|
|
"t" directory upwards of $file or $dir. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$file takes precedence over $dir if both are specified. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
If none if this works out, no Project can be created and undef is |
196
|
|
|
|
|
|
|
returned. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Return the new object, or undef if no project could be found. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
sub newFromLocation(@) { |
202
|
59
|
|
|
59
|
1
|
112
|
my $pkg = shift; |
203
|
59
|
|
|
|
|
591
|
my ($oPerlySense) = Devel::PerlySense::Util::aNamedArg(["oPerlySense"], @_); |
204
|
59
|
|
|
|
|
207
|
my %p = @_; |
205
|
59
|
|
|
|
|
139
|
my $file = $p{file}; |
206
|
59
|
|
|
|
|
99
|
my $dir = $p{dir}; |
207
|
59
|
100
|
|
|
|
747
|
$file and $dir = dirname($file); |
208
|
59
|
50
|
|
|
|
400
|
$dir and $dir = dir($dir)->absolute; |
209
|
|
|
|
|
|
|
|
210
|
59
|
|
|
|
|
18053
|
my $oProject; |
211
|
|
|
|
|
|
|
|
212
|
59
|
100
|
66
|
|
|
193
|
$dir and $oProject = $pkg->newFindExplicit( |
213
|
|
|
|
|
|
|
dir => $dir, |
214
|
|
|
|
|
|
|
oPerlySense => $oPerlySense, |
215
|
|
|
|
|
|
|
) and return $oProject; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
#If file, look for the dir from where any package in the file can |
219
|
|
|
|
|
|
|
#be used |
220
|
7
|
100
|
66
|
|
|
35
|
if($file and my $oDocument = $oPerlySense->oDocumentParseFile($file)) { |
221
|
4
|
|
|
|
|
18
|
for my $package ($oDocument->aNamePackage) { |
222
|
2
|
|
|
|
|
90
|
my $filePackage = $oPerlySense->fileFromModule($package); |
223
|
2
|
|
|
|
|
563
|
my $dirFound = $oPerlySense->dirFindLookingAround($filePackage, $dir); |
224
|
|
|
|
|
|
|
|
225
|
2
|
50
|
|
|
|
270
|
if($dirFound) { |
226
|
2
|
|
|
|
|
5
|
my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin |
227
|
2
|
|
|
|
|
292
|
return $pkg->new( |
228
|
|
|
|
|
|
|
oPerlySense => $oPerlySense, |
229
|
|
|
|
|
|
|
dirProjectImplicitUse => $dirProject, |
230
|
|
|
|
|
|
|
); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
#If dir, look for dirs |
236
|
5
|
50
|
|
|
|
209
|
if($dir) { |
237
|
5
|
|
66
|
|
|
39
|
my $dirFound = |
238
|
|
|
|
|
|
|
$oPerlySense->fileFindLookingAround("lib", $dir) || |
239
|
|
|
|
|
|
|
$oPerlySense->fileFindLookingAround("t", $dir); |
240
|
|
|
|
|
|
|
|
241
|
5
|
100
|
|
|
|
519
|
if($dirFound) { |
242
|
3
|
|
|
|
|
9
|
my $dirProject = dir($dirFound)->parent . ""; ###TODO: if lib or bin |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
#Special case the Unix style root dir. It's never a |
245
|
|
|
|
|
|
|
#Project dir, but if often contains a lib dir and so will |
246
|
|
|
|
|
|
|
#get identified as a Project. |
247
|
|
|
|
|
|
|
# |
248
|
|
|
|
|
|
|
#If it _is_ a root dir, this can be overriden with an |
249
|
|
|
|
|
|
|
#explicit .PerlySenseProject dir. |
250
|
|
|
|
|
|
|
# |
251
|
|
|
|
|
|
|
#On Windows, the root looks like X:\, and it's not |
252
|
|
|
|
|
|
|
#entirely unlikely that a secondary drive or a SUBST drive |
253
|
|
|
|
|
|
|
#letter contains the project root. |
254
|
3
|
50
|
|
|
|
400
|
$dirProject eq "/" and return undef; |
255
|
|
|
|
|
|
|
|
256
|
3
|
|
|
|
|
27
|
return $pkg->new( |
257
|
|
|
|
|
|
|
oPerlySense => $oPerlySense, |
258
|
|
|
|
|
|
|
dirProjectImplicitDir => $dirProject, |
259
|
|
|
|
|
|
|
); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
2
|
|
|
|
|
14
|
return(undef); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=head2 newFindExplicit(dir => $dir, oPerlySense => $oPs) |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
Create new Project if there is an explicit .PerlySenseProject |
273
|
|
|
|
|
|
|
directory in the path above $dir. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
Return the new object, or undef if no project could be found. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
sub newFindExplicit(@) { |
279
|
54
|
|
|
54
|
1
|
580
|
my $pkg = shift; |
280
|
54
|
|
|
|
|
253
|
my ($oPerlySense, $dir) = Devel::PerlySense::Util::aNamedArg(["oPerlySense", "dir"], @_); |
281
|
|
|
|
|
|
|
|
282
|
54
|
100
|
|
|
|
313
|
if(my $dirProject = $oPerlySense->dirFindLookingAround( |
283
|
|
|
|
|
|
|
".PerlySenseProject", |
284
|
|
|
|
|
|
|
$dir, |
285
|
|
|
|
|
|
|
["."], |
286
|
|
|
|
|
|
|
)) { |
287
|
52
|
|
|
|
|
2874
|
return $pkg->new( |
288
|
|
|
|
|
|
|
oPerlySense => $oPerlySense, |
289
|
|
|
|
|
|
|
dirProjectExplicitDir => $dirProject, |
290
|
|
|
|
|
|
|
oConfig => Devel::PerlySense::Config::Project->new(dirRoot => $dirProject), |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
2
|
|
|
|
|
18
|
return undef; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=head1 MEHTODS |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head2 rhRunFile(file => $fileSource, [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Like rhRunFile0, but with what => "run". |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=cut |
308
|
4
|
|
|
4
|
1
|
18
|
sub rhRunFile { |
309
|
4
|
|
|
|
|
12
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
310
|
4
|
|
|
|
|
9
|
my %p = @_; |
311
|
4
|
|
|
|
|
14
|
return( $self->rhRunFile0(%p, what => "run") ); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head2 rhDebugFile(file => $fileSource, [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Like rhRunFile0, but with what => "debug". |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=cut |
323
|
|
|
|
|
|
|
### XXX refactor, DRY with rhRunFile |
324
|
1
|
|
|
1
|
1
|
5
|
sub rhDebugFile { |
325
|
1
|
|
|
|
|
5
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
326
|
1
|
|
|
|
|
3
|
my %p = @_; |
327
|
1
|
|
|
|
|
6
|
return( $self->rhRunFile0(%p, what => "debug") ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head2 rhRunFile0(file => $fileSource, what => "run" | "debug", [rhConfigType = DEDUCED_FROM_FILE], [ keyConfigCommand = "command" ]) |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Figure out what type of source file $fileSource is, and how it should |
337
|
|
|
|
|
|
|
be run/debugged. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
The settings in the global config->{$what_file} is used to determine |
340
|
|
|
|
|
|
|
the details. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
The command to use is taken from |
343
|
|
|
|
|
|
|
config->{$what_file}->{$keyConfigCommand}, if that is specified, |
344
|
|
|
|
|
|
|
otherwise for "command". |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Return hash ref with (keys: "dir_$what_from", "command_$what", |
347
|
|
|
|
|
|
|
"type_source_file"), or die on errors (like if no Project could be |
348
|
|
|
|
|
|
|
found). |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
dir_$what_from is an absolute directory name which should be the cwd |
351
|
|
|
|
|
|
|
when command_$what is executed. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
type_source_file is something like "Test", "Module". |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=cut |
356
|
5
|
|
|
5
|
1
|
5
|
sub rhRunFile0 { |
357
|
5
|
|
|
|
|
16
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
358
|
5
|
|
|
|
|
13
|
my %p = @_; |
359
|
5
|
|
|
|
|
8
|
my $rhConfigType = $p{rhConfigType}; |
360
|
5
|
|
|
|
|
6
|
my $what = $p{what}; |
361
|
5
|
|
100
|
|
|
20
|
my $keyConfigCommand = $p{keyConfigCommand} || "command"; |
362
|
|
|
|
|
|
|
|
363
|
5
|
|
|
|
|
9
|
$file = file($file)->absolute; |
364
|
5
|
|
33
|
|
|
1272
|
$rhConfigType ||= $self->rhConfigTypeForFile( |
365
|
|
|
|
|
|
|
file => $file, |
366
|
|
|
|
|
|
|
keyConfig => "${what}_file", |
367
|
|
|
|
|
|
|
); |
368
|
|
|
|
|
|
|
|
369
|
5
|
|
|
|
|
199
|
my $dirProject = dir($self->dirProject)->absolute; |
370
|
|
|
|
|
|
|
my %hTypeDirRunFrom = ( |
371
|
3
|
|
|
3
|
|
5
|
source_root_directory => sub { $dirProject }, |
372
|
2
|
|
|
2
|
|
6
|
file_directory => sub { $file->dir }, |
373
|
5
|
|
|
|
|
486
|
); |
374
|
5
|
|
|
|
|
13
|
my $typeRunFrom = $rhConfigType->{"${what}_from"}; |
375
|
5
|
50
|
|
|
|
12
|
my $rsDirRunFrom = $hTypeDirRunFrom{$typeRunFrom} or die("Invalid ${what}_from value ($typeRunFrom)\n" . Dumper($rhConfigType) . "Allowed values: (" . join(", ", (sort keys %hTypeDirRunFrom)) . ")\n"); |
376
|
5
|
|
|
|
|
7
|
my $dirRunFrom = $rsDirRunFrom->(); |
377
|
|
|
|
|
|
|
|
378
|
5
|
|
|
|
|
18
|
my @aDirIncProject = $self->aDirIncProject(dirRelativeTo => $dirRunFrom); |
379
|
5
|
|
|
|
|
11
|
my $optionInc = join(" ", map { qq|"-I$_"| } @aDirIncProject); |
|
19
|
|
|
|
|
30
|
|
380
|
|
|
|
|
|
|
|
381
|
5
|
|
|
|
|
23
|
my $fileSource = $file->relative($dirRunFrom); |
382
|
5
|
50
|
33
|
|
|
1584
|
my $command |
383
|
|
|
|
|
|
|
= $rhConfigType->{ $keyConfigCommand } |
384
|
|
|
|
|
|
|
|| $rhConfigType->{command} |
385
|
|
|
|
|
|
|
or die("Could not find a config value for which 'command' to run\n"); |
386
|
5
|
|
|
|
|
12
|
my $commandRun = textRenderTemplate( |
387
|
|
|
|
|
|
|
$command, |
388
|
|
|
|
|
|
|
{ |
389
|
|
|
|
|
|
|
INC => $optionInc, |
390
|
|
|
|
|
|
|
SOURCE_FILE => $fileSource . "", |
391
|
|
|
|
|
|
|
}, |
392
|
|
|
|
|
|
|
); |
393
|
|
|
|
|
|
|
|
394
|
5
|
|
|
|
|
23
|
my $rhConfigRun = { |
395
|
|
|
|
|
|
|
"dir_${what}_from" => $dirRunFrom . "", |
396
|
|
|
|
|
|
|
"command_${what}" => $commandRun, |
397
|
|
|
|
|
|
|
type_source_file => $rhConfigType->{moniker}, |
398
|
|
|
|
|
|
|
}; |
399
|
5
|
|
|
|
|
180
|
return($rhConfigRun); |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=head2 rhConfigTypeForFile(file => $fileSource, keyConfig => CONFIG_KEY) |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Return the config type hash ref (keys: command, moniker) from the ones |
409
|
|
|
|
|
|
|
available in the config. Match the $fileSource name against each rex |
410
|
|
|
|
|
|
|
in the config. |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Die if no configType could be identified. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=cut |
415
|
19
|
|
|
19
|
1
|
20
|
sub rhConfigTypeForFile { |
416
|
19
|
|
|
|
|
55
|
my ($file, $keyConfig) = Devel::PerlySense::Util::aNamedArg(["file", "keyConfig"], @_); |
417
|
|
|
|
|
|
|
|
418
|
19
|
|
|
|
|
483
|
my $rhConfig = $self->oPerlySense->rhConfig; |
419
|
19
|
|
|
|
|
583
|
for my $rhConfigType (@{ $rhConfig->{ $keyConfig } }) { |
|
19
|
|
|
|
|
30
|
|
420
|
33
|
100
|
|
|
|
62
|
my $rex = $rhConfigType->{rex} |
421
|
|
|
|
|
|
|
or die("Missing rex key in config chunk: " . Dumper($rhConfigType)); |
422
|
|
|
|
|
|
|
|
423
|
31
|
100
|
|
|
|
23
|
eval { $file =~ /$rex/ } and return $rhConfigType; |
|
31
|
|
|
|
|
280
|
|
424
|
18
|
100
|
|
|
|
176
|
$@ and die("Invalid rex value in config chunk.\nError: $@\n" . Dumper($rhConfigType)); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
2
|
|
|
|
|
14
|
die("No run_perl rex matched the file ($file). Please check your config\n"); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head2 aDirIncProject(dirRelativeTo => $dirRelativeTo) |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Return array with dir objects which are the inc_dir directories in the |
437
|
|
|
|
|
|
|
config, plus the usual inc directories. They are all relative to |
438
|
|
|
|
|
|
|
$dirRelativeTo. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=cut |
441
|
717
|
|
|
717
|
1
|
9645
|
sub aDirIncProject { |
442
|
717
|
|
|
|
|
2319
|
my ($dirRelativeTo) = Devel::PerlySense::Util::aNamedArg(["dirRelativeTo"], @_); |
443
|
|
|
|
|
|
|
|
444
|
717
|
|
|
|
|
1796
|
my $dirProject = dir($self->dirProject)->absolute; |
445
|
717
|
|
|
|
|
54201
|
my $dirProjectRelativeTo = $dirProject->relative( $dirRelativeTo ); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
###TODO: extract method for the inc_dir config entry aIncDirConfig |
448
|
717
|
50
|
|
|
|
100265
|
my @aDirIncProject = @{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] }; |
|
717
|
|
|
|
|
23901
|
|
449
|
717
|
|
|
|
|
26280
|
my @aDirInc = (@aDirIncProject, ".", "lib"); |
450
|
|
|
|
|
|
|
|
451
|
1443
|
|
|
|
|
54948
|
my @aDirIncRelative = |
452
|
717
|
|
|
|
|
1148
|
map { dir($dirProjectRelativeTo, $_) . "" } |
453
|
|
|
|
|
|
|
@aDirInc; |
454
|
|
|
|
|
|
|
|
455
|
717
|
|
|
|
|
55292
|
return @aDirIncRelative; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head2 aDirIncAbsolute() |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Return array with absolute dir objects which are the inc_dir |
465
|
|
|
|
|
|
|
directories in the config, plus the usual inc directories. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=cut |
468
|
534
|
|
|
534
|
1
|
3276
|
sub aDirIncAbsolute { |
469
|
534
|
|
|
|
|
1930
|
my $dirProject = dir($self->dirProject)->absolute; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
###TODO: extract method for the inc_dir config entry aIncDirConfig |
472
|
534
|
50
|
|
|
|
14154
|
my @aDirIncProject = @{ |
473
|
534
|
|
|
|
|
39243
|
$self->oPerlySense->rhConfig->{project}->{inc_dir} || [] |
474
|
|
|
|
|
|
|
}; |
475
|
534
|
|
|
|
|
19750
|
my @aDirInc = (@aDirIncProject, ".", "lib"); |
476
|
|
|
|
|
|
|
|
477
|
1071
|
|
|
|
|
54332
|
my @aDirIncAbsolute = |
478
|
534
|
|
|
|
|
875
|
map { dir($dirProject, $_)->absolute . "" } |
479
|
|
|
|
|
|
|
@aDirInc; |
480
|
534
|
|
|
|
|
56687
|
return @aDirIncAbsolute; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head2 isFileInProject(file => $file) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Return true if $file is within the project root, or in any of the INC |
490
|
|
|
|
|
|
|
directories, else false. Die on errors. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Test logically/structurally, not whether the file actually exists. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=cut |
495
|
7
|
|
|
7
|
1
|
17
|
sub isFileInProject { |
496
|
7
|
|
|
|
|
28
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
497
|
|
|
|
|
|
|
|
498
|
15
|
|
|
|
|
695
|
my @aDirInc = |
499
|
7
|
50
|
|
|
|
186
|
map { dir($self->dirProject, $_) } |
500
|
7
|
|
|
|
|
13
|
@{ $self->oPerlySense->rhConfig->{project}->{inc_dir} || [] }; |
501
|
22
|
|
|
|
|
2758
|
my @aDirSourceAbsolute = |
502
|
7
|
|
|
|
|
322
|
map { dir($_)->absolute } |
503
|
|
|
|
|
|
|
($self->dirProject, @aDirInc); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
###TODO: Comment out debug statements when that failing test in t/PerlySense-Project-file-in-project.t is fixed |
506
|
7
|
|
|
|
|
1063
|
debug("\nTESTING WHETHER FILE\n($file) IS IN PROJECT\n(" . $self->dirProject . "),\ni.e.\n(" . join(")\n(", @aDirSourceAbsolute) . ")\n"); |
507
|
7
|
|
|
|
|
20
|
my @aDirProjectRegex = map { qr/^ \Q$_\E /x } @aDirSourceAbsolute; |
|
22
|
|
|
|
|
529
|
|
508
|
|
|
|
|
|
|
|
509
|
7
|
|
|
|
|
249
|
my $dirFileAbsolute = dir( filePathNormalize( file($file)->absolute->dir ) ); |
510
|
7
|
|
|
|
|
1150
|
debug("DIR ABSOLUTE ($dirFileAbsolute)\n"); |
511
|
|
|
|
|
|
|
|
512
|
7
|
|
|
|
|
15
|
for my $dirProject (map { dir(filePathNormalize($_)) } @aDirSourceAbsolute) { |
|
22
|
|
|
|
|
2753
|
|
513
|
16
|
|
|
|
|
3381
|
debug("Checking whether\n($dirFileAbsolute) is within\n($dirProject)\n"); |
514
|
16
|
100
|
|
|
|
47
|
$dirProject->subsumes($dirFileAbsolute) and debug("Found it"), return 1; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
3
|
|
|
|
|
987
|
debug("FILE ($file) is NOT in the Project (" . $self->dirProject . ")\n"); |
518
|
3
|
|
|
|
|
720
|
return 0; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=head2 flymakeFile(file => $fileSource) |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
Do a flymake run with $fileSource according to the flymake config and |
528
|
|
|
|
|
|
|
output the result to STDOUT and STDERR. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Return 1 or die on errors (but that will look like the result of a |
531
|
|
|
|
|
|
|
failed flymake run). |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=cut |
534
|
|
|
|
|
|
|
|
535
|
0
|
|
|
0
|
1
|
|
sub flymakeFile { |
536
|
0
|
|
|
|
|
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
537
|
|
|
|
|
|
|
|
538
|
0
|
0
|
|
|
|
|
if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{syntax}) { |
539
|
0
|
|
|
|
|
|
my $rhConfigRun = $self->rhRunFile( |
540
|
|
|
|
|
|
|
file => $file, |
541
|
|
|
|
|
|
|
rhConfigType => { |
542
|
|
|
|
|
|
|
command => q{perl -c ${INC} "${SOURCE_FILE}" 2>&1 | perl -ne " /Subroutine [\\w:]+ redefined at/ or print"}, |
543
|
|
|
|
|
|
|
moniker => "Flymake", |
544
|
|
|
|
|
|
|
rex => "", |
545
|
|
|
|
|
|
|
run_from => "file_directory", |
546
|
|
|
|
|
|
|
}, |
547
|
|
|
|
|
|
|
); |
548
|
|
|
|
|
|
|
|
549
|
0
|
|
|
|
|
|
local $CWD = $rhConfigRun->{dir_run_from}; |
550
|
0
|
|
|
|
|
|
system( $rhConfigRun->{command_run} ); |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
0
|
0
|
|
|
|
|
if($self->oPerlySense->rhConfig->{external}{editor}{emacs}{flymake}{critic}) { |
554
|
|
|
|
|
|
|
###TODO: don't run if syntax errors found |
555
|
|
|
|
|
|
|
|
556
|
0
|
|
|
|
|
|
my $fileConfigCritic = file( |
557
|
|
|
|
|
|
|
dir($self->dirProject)->absolute, ".PerlySenseProject", ".perlcritic", |
558
|
|
|
|
|
|
|
); |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
|
|
|
|
my @aOption = (-profile => $fileConfigCritic . ""); |
561
|
0
|
0
|
|
|
|
|
-e $fileConfigCritic or @aOption = (); |
562
|
|
|
|
|
|
|
|
563
|
0
|
|
|
|
|
|
my $oCritic = Perl::Critic->new(@aOption); |
564
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
my @aViolation = $oCritic->critique($file); |
566
|
|
|
|
|
|
|
|
567
|
0
|
|
|
|
|
|
Perl::Critic::Violation::set_format( "%m near '%r' (%e, %p) at %f line %l.\n" ); |
568
|
0
|
|
|
|
|
|
for my $violation (@aViolation) { |
569
|
0
|
|
|
|
|
|
print STDERR "Warning: $violation"; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
return 1; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=head2 rhSubCovered(file => $fileSource) |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Do a "covered subs" call with $fileSource. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
Die if Devel::CoverX::Covered isn't installed. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Return hash ref with (keys: sub name; values: quality)), or an empty |
587
|
|
|
|
|
|
|
hash ref if no coverage info was found for $fileSource. |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Any subs with the same name will have their qualities combined. |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=cut |
592
|
0
|
|
|
0
|
1
|
|
sub rhSubCovered { |
593
|
0
|
|
|
|
|
|
my ($file) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
594
|
|
|
|
|
|
|
|
595
|
0
|
|
|
|
|
|
local $CWD = $self->dirProject; |
596
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
eval { |
598
|
0
|
|
|
|
|
|
require Devel::CoverX::Covered; |
599
|
0
|
|
|
|
|
|
require Devel::CoverX::Covered::Db; |
600
|
|
|
|
|
|
|
}; |
601
|
0
|
0
|
|
|
|
|
$@ and die("Devel::CoverX::Covered isn't installed\n"); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
###TODO: use dir specified in config and/or on command line |
604
|
0
|
|
|
|
|
|
local $CWD = $self->dirProject . ""; |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
###TODO: Change Devel::CoverX::Covered to expose this dir properly |
607
|
|
|
|
|
|
|
###and get it from there. |
608
|
0
|
|
|
|
|
|
my $dirDb = "covered"; |
609
|
0
|
0
|
|
|
|
|
-d $dirDb or return( {} ); |
610
|
|
|
|
|
|
|
|
611
|
0
|
|
|
|
|
|
my $db = Devel::CoverX::Covered::Db->new(); |
612
|
0
|
|
|
|
|
|
my $fileRelative = file($file)->relative( $self->dirProject ); |
613
|
0
|
|
|
|
|
|
my %hSubQuality; |
614
|
0
|
|
|
|
|
|
for my $raSubQuality ( $db->covered_subs($fileRelative) ) { |
615
|
0
|
|
|
|
|
|
my ($sub, $quality) = @$raSubQuality; |
616
|
0
|
|
|
|
|
|
$hSubQuality{$sub} += $quality; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
0
|
|
|
|
|
|
return(\%hSubQuality); |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=head2 raFileTestOther(file => $fileSource, [sub => $sub]) |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
Return array ref with file names of files related to $file and |
629
|
|
|
|
|
|
|
possibly $sub, i.e. the "other" files related $file. |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
If $file is a source file, return test files, and vice verca. |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
$sub is only ever active when $fileSource is a source file. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
Die if Devel::CoverX::Covered isn't installed. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=cut |
638
|
0
|
|
|
0
|
1
|
|
sub raFileTestOther { |
639
|
0
|
|
|
|
|
|
my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file", "sub"], @_); |
640
|
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
eval { |
642
|
0
|
|
|
|
|
|
require Devel::CoverX::Covered; |
643
|
0
|
|
|
|
|
|
require Devel::CoverX::Covered::Db; |
644
|
|
|
|
|
|
|
}; |
645
|
0
|
0
|
|
|
|
|
$@ and die("Devel::CoverX::Covered isn't installed\n"); |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
###TODO: verify there is a cover_db database present |
648
|
|
|
|
|
|
|
|
649
|
0
|
|
|
|
|
|
local $CWD = $self->dirProject . ""; |
650
|
|
|
|
|
|
|
|
651
|
0
|
|
|
|
|
|
my $db = Devel::CoverX::Covered::Db->new(); |
652
|
|
|
|
|
|
|
|
653
|
0
|
|
|
|
|
|
my $method = "source_files_covered_by"; # Default to test file |
654
|
0
|
0
|
|
|
|
|
$file =~ m|\.pm$| and $method = "test_files_covering"; # If a module, it's source |
655
|
0
|
0
|
|
|
|
|
$file =~ m|/t/| and $method = "source_files_covered_by"; # If it's in /t/, it's a test |
656
|
0
|
0
|
|
|
|
|
$file =~ m|\.t$| and $method = "source_files_covered_by"; # If it's a .t file, it's a test |
657
|
|
|
|
|
|
|
### TODO: config with list of lib dirs and list of test dirs |
658
|
0
|
|
|
|
|
|
debug("raFileTestOther with method ($method)"); |
659
|
|
|
|
|
|
|
|
660
|
0
|
|
|
|
|
|
my $fileRelative = file($file)->relative( $self->dirProject ); |
661
|
0
|
|
|
|
|
|
my $raFileTestOther = [ $db->$method($fileRelative, $sub) ]; |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
return($raFileTestOther); |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head2 raFileProjectOther(file => $fileSource, [sub => $sub]) |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Return array ref with file names of files corresponding to $file. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Die if there is no config file. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=cut |
677
|
0
|
|
|
0
|
1
|
|
sub raFileProjectOther { |
678
|
0
|
|
|
|
|
|
my ($file, $sub) = Devel::PerlySense::Util::aNamedArg(["file"], @_); |
679
|
|
|
|
|
|
|
|
680
|
0
|
|
|
|
|
|
eval { |
681
|
0
|
|
|
|
|
|
require File::Corresponding; |
682
|
0
|
|
|
|
|
|
require File::Corresponding::Config::Find; |
683
|
|
|
|
|
|
|
}; |
684
|
0
|
0
|
|
|
|
|
$@ and die("File::Corresponding isn't installed\n"); |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
# Work from the project dir, so the rest of the paths will just work out |
688
|
0
|
|
|
|
|
|
local $CWD = $self->dirProject . ""; |
689
|
|
|
|
|
|
|
|
690
|
0
|
0
|
|
|
|
|
my $fileConfig = File::Corresponding::Config::Find->new( |
691
|
|
|
|
|
|
|
preferred_dirs => [ dir(".PerlySenseProject"), dir(".") ], |
692
|
|
|
|
|
|
|
)->user_config(".corresponding_file") |
693
|
|
|
|
|
|
|
or die("Could not find a '.corresponding_file' config file in either 1) the .PerlySenseProject; b) the current directory; c) your home directory. See perldoc File::Corresponding for information on how to create one.\n"); |
694
|
|
|
|
|
|
|
|
695
|
0
|
|
|
|
|
|
my $corresponding = File::Corresponding->new(); |
696
|
0
|
0
|
|
|
|
|
eval { $corresponding->load_config_file($fileConfig) } |
|
0
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
or die("Could not read config file ($fileConfig): $@\n"); |
698
|
|
|
|
|
|
|
|
699
|
0
|
|
|
|
|
|
my $fileRelative = file($file)->relative( $self->dirProject ); |
700
|
0
|
|
|
|
|
|
my @aFileProjectOther = uniq( |
701
|
0
|
|
|
|
|
|
map { $_->file } |
702
|
0
|
|
|
|
|
|
@{$corresponding->corresponding( $fileRelative )} |
703
|
|
|
|
|
|
|
); |
704
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
|
return(\@aFileProjectOther); |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
1; |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
__END__ |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=encoding utf8 |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=head1 AUTHOR |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
Johan Lindström, C<< <johanl[ÄT]DarSerMan.com> >> |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=head1 BUGS |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
730
|
|
|
|
|
|
|
C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at |
731
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>. |
732
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
733
|
|
|
|
|
|
|
your bug as I make changes. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
Copyright 2005 Johan Lindström, All Rights Reserved. |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
742
|
|
|
|
|
|
|
under the same terms as Perl itself. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=cut |