| 107 |
bj |
1 |
package WorkspaceCreator;
|
|
|
2 |
|
|
|
3 |
# ************************************************************
|
|
|
4 |
# Description : Base class for all workspace creators
|
|
|
5 |
# Author : Chad Elliott
|
|
|
6 |
# Create Date : 5/13/2002
|
|
|
7 |
# ************************************************************
|
|
|
8 |
|
|
|
9 |
# ************************************************************
|
|
|
10 |
# Pragmas
|
|
|
11 |
# ************************************************************
|
|
|
12 |
|
|
|
13 |
use strict;
|
|
|
14 |
use FileHandle;
|
|
|
15 |
use File::Path;
|
|
|
16 |
use File::Compare;
|
|
|
17 |
|
|
|
18 |
use Creator;
|
|
|
19 |
use Options;
|
|
|
20 |
|
|
|
21 |
use vars qw(@ISA);
|
|
|
22 |
@ISA = qw(Creator Options);
|
|
|
23 |
|
|
|
24 |
# ************************************************************
|
|
|
25 |
# Data Section
|
|
|
26 |
# ************************************************************
|
|
|
27 |
|
|
|
28 |
my($wsext) = 'mwc';
|
|
|
29 |
my($wsbase) = 'mwb';
|
|
|
30 |
|
|
|
31 |
## Valid names for assignments within a workspace
|
|
|
32 |
my(%validNames) = ('cmdline' => 1,
|
|
|
33 |
'implicit' => 1,
|
|
|
34 |
);
|
|
|
35 |
|
|
|
36 |
## Singleton hash maps of project information
|
|
|
37 |
my(%allprinfo) = ();
|
|
|
38 |
my(%allprojects) = ();
|
|
|
39 |
my(%allliblocs) = ();
|
|
|
40 |
|
|
|
41 |
## Global previous workspace names
|
|
|
42 |
my(%previous_workspace_name) = ();
|
|
|
43 |
|
|
|
44 |
## Constant aggregated workspace type name
|
|
|
45 |
my($aggregated) = 'aggregated_workspace';
|
|
|
46 |
|
|
|
47 |
# ************************************************************
|
|
|
48 |
# Subroutine Section
|
|
|
49 |
# ************************************************************
|
|
|
50 |
|
|
|
51 |
sub new {
|
|
|
52 |
my($class) = shift;
|
|
|
53 |
my($global) = shift;
|
|
|
54 |
my($inc) = shift;
|
|
|
55 |
my($template) = shift;
|
|
|
56 |
my($ti) = shift;
|
|
|
57 |
my($dynamic) = shift;
|
|
|
58 |
my($static) = shift;
|
|
|
59 |
my($relative) = shift;
|
|
|
60 |
my($addtemp) = shift;
|
|
|
61 |
my($addproj) = shift;
|
|
|
62 |
my($progress) = shift;
|
|
|
63 |
my($toplevel) = shift;
|
|
|
64 |
my($baseprojs) = shift;
|
|
|
65 |
my($gfeature) = shift;
|
|
|
66 |
my($feature) = shift;
|
|
|
67 |
my($features) = shift;
|
|
|
68 |
my($hierarchy) = shift;
|
|
|
69 |
my($exclude) = shift;
|
|
|
70 |
my($makeco) = shift;
|
|
|
71 |
my($nmod) = shift;
|
|
|
72 |
my($applypj) = shift;
|
|
|
73 |
my($genins) = shift;
|
|
|
74 |
my($into) = shift;
|
|
|
75 |
my($language) = shift;
|
|
|
76 |
my($use_env) = shift;
|
|
|
77 |
my($expandvars) = shift;
|
|
|
78 |
my($self) = Creator::new($class, $global, $inc,
|
|
|
79 |
$template, $ti, $dynamic, $static,
|
|
|
80 |
$relative, $addtemp, $addproj,
|
|
|
81 |
$progress, $toplevel, $baseprojs,
|
|
|
82 |
$feature, $features,
|
|
|
83 |
$hierarchy, $nmod, $applypj,
|
|
|
84 |
$into, $language, $use_env, $expandvars,
|
|
|
85 |
'workspace');
|
|
|
86 |
|
|
|
87 |
$self->{'workspace_name'} = undef;
|
|
|
88 |
$self->{$self->{'type_check'}} = 0;
|
|
|
89 |
$self->{'projects'} = [];
|
|
|
90 |
$self->{'project_info'} = {};
|
|
|
91 |
$self->{'lib_locations'} = {};
|
|
|
92 |
$self->{'reading_parent'} = [];
|
|
|
93 |
$self->{'project_files'} = [];
|
|
|
94 |
$self->{'scoped_assign'} = {};
|
|
|
95 |
$self->{'cacheok'} = 1;
|
|
|
96 |
$self->{'exclude'} = {};
|
|
|
97 |
$self->{'wctype'} = $self->extractType("$self");
|
|
|
98 |
$self->{'modified_count'} = 0;
|
|
|
99 |
$self->{'global_feature_file'} = $gfeature;
|
|
|
100 |
$self->{'coexistence'} = $makeco;
|
|
|
101 |
$self->{'project_file_list'} = {};
|
|
|
102 |
$self->{'ordering_cache'} = {};
|
|
|
103 |
$self->{'handled_scopes'} = {};
|
|
|
104 |
$self->{'generate_ins'} = $genins;
|
|
|
105 |
$self->{'scoped_basedir'} = undef;
|
|
|
106 |
|
|
|
107 |
if (defined $$exclude[0]) {
|
|
|
108 |
my($type) = $self->{'wctype'};
|
|
|
109 |
if (!defined $self->{'exclude'}->{$type}) {
|
|
|
110 |
$self->{'exclude'}->{$type} = [];
|
|
|
111 |
}
|
|
|
112 |
push(@{$self->{'exclude'}->{$type}}, @$exclude);
|
|
|
113 |
}
|
|
|
114 |
|
|
|
115 |
## Add a hash reference for our workspace type
|
|
|
116 |
if (!defined $previous_workspace_name{$self->{'wctype'}}) {
|
|
|
117 |
$previous_workspace_name{$self->{'wctype'}} = {};
|
|
|
118 |
}
|
|
|
119 |
|
|
|
120 |
## Warn users about unnecessary options
|
|
|
121 |
if ($self->get_hierarchy() && $self->workspace_per_project()) {
|
|
|
122 |
$self->warning("The -hierarchy option is unnecessary " .
|
|
|
123 |
"for the " . $self->{'wctype'} . " type.");
|
|
|
124 |
}
|
|
|
125 |
if ($self->make_coexistence() && !$self->supports_make_coexistence()) {
|
|
|
126 |
$self->warning("Using the -make_coexistence option has " .
|
|
|
127 |
"no effect on the " . $self->{'wctype'} . " type.");
|
|
|
128 |
}
|
|
|
129 |
return $self;
|
|
|
130 |
}
|
|
|
131 |
|
|
|
132 |
|
|
|
133 |
sub modify_assignment_value {
|
|
|
134 |
my($self) = shift;
|
|
|
135 |
my($name) = shift;
|
|
|
136 |
my($value) = shift;
|
|
|
137 |
|
|
|
138 |
## Workspace assignments do not need modification.
|
|
|
139 |
return $value;
|
|
|
140 |
}
|
|
|
141 |
|
|
|
142 |
|
|
|
143 |
sub parse_line {
|
|
|
144 |
my($self) = shift;
|
|
|
145 |
my($ih) = shift;
|
|
|
146 |
my($line) = shift;
|
|
|
147 |
my($status, $error, @values) = $self->parse_known($line);
|
|
|
148 |
|
|
|
149 |
## Was the line recognized?
|
|
|
150 |
if ($status && defined $values[0]) {
|
|
|
151 |
if ($values[0] eq $self->{'grammar_type'}) {
|
|
|
152 |
my($name) = $values[1];
|
|
|
153 |
if (defined $name && $name eq '}') {
|
|
|
154 |
if (!defined $self->{'reading_parent'}->[0]) {
|
|
|
155 |
## Fill in all the default values
|
|
|
156 |
$self->generate_defaults();
|
|
|
157 |
|
|
|
158 |
## End of workspace; Have subclass write out the file
|
|
|
159 |
## Generate the project files
|
| 198 |
bj |
160 |
my($gstat, $creator, $err) = $self->generate_project_files();
|
| 107 |
bj |
161 |
if ($gstat) {
|
|
|
162 |
($status, $error) = $self->write_workspace($creator, 1);
|
|
|
163 |
$self->{'assign'} = {};
|
|
|
164 |
}
|
|
|
165 |
else {
|
| 198 |
bj |
166 |
$error = $err;
|
| 107 |
bj |
167 |
$status = 0;
|
|
|
168 |
}
|
|
|
169 |
|
|
|
170 |
$self->{'modified_count'} = 0;
|
|
|
171 |
$self->{'workspace_name'} = undef;
|
|
|
172 |
$self->{'projects'} = [];
|
|
|
173 |
$self->{'project_info'} = {};
|
|
|
174 |
$self->{'project_files'} = [];
|
|
|
175 |
}
|
|
|
176 |
$self->{$self->{'type_check'}} = 0;
|
|
|
177 |
}
|
|
|
178 |
else {
|
|
|
179 |
## Workspace Beginning
|
|
|
180 |
## Deal with the inheritance hiearchy first
|
|
|
181 |
if (defined $values[2]) {
|
|
|
182 |
foreach my $parent (@{$values[2]}) {
|
|
|
183 |
## Read in the parent onto ourself
|
|
|
184 |
my($file) = $self->search_include_path("$parent.$wsbase");
|
|
|
185 |
if (!defined $file) {
|
|
|
186 |
$file = $self->search_include_path("$parent.$wsext");
|
|
|
187 |
}
|
|
|
188 |
|
|
|
189 |
if (defined $file) {
|
|
|
190 |
push(@{$self->{'reading_parent'}}, 1);
|
|
|
191 |
$status = $self->parse_file($file);
|
|
|
192 |
pop(@{$self->{'reading_parent'}});
|
|
|
193 |
|
|
|
194 |
if (!$status) {
|
|
|
195 |
$error = "Invalid parent: $parent";
|
|
|
196 |
}
|
|
|
197 |
}
|
|
|
198 |
else {
|
|
|
199 |
$status = 0;
|
|
|
200 |
$error = "Unable to locate parent: $parent";
|
|
|
201 |
}
|
|
|
202 |
}
|
|
|
203 |
}
|
|
|
204 |
|
|
|
205 |
## Set up some initial values
|
|
|
206 |
if (defined $name) {
|
|
|
207 |
if ($name =~ /[\/\\]/) {
|
|
|
208 |
$status = 0;
|
|
|
209 |
$error = 'Workspaces can not have a slash ' .
|
|
|
210 |
'or a back slash in the name';
|
|
|
211 |
}
|
|
|
212 |
else {
|
|
|
213 |
$name =~ s/^\(\s*//;
|
|
|
214 |
$name =~ s/\s*\)$//;
|
|
|
215 |
|
|
|
216 |
## Replace any *'s with the default name
|
| 217 |
bj |
217 |
if (index($name, '*') >= 0) {
|
| 107 |
bj |
218 |
$name = $self->fill_type_name(
|
|
|
219 |
$name,
|
|
|
220 |
$self->get_default_workspace_name());
|
|
|
221 |
}
|
|
|
222 |
|
|
|
223 |
$self->{'workspace_name'} = $name;
|
|
|
224 |
}
|
|
|
225 |
}
|
|
|
226 |
$self->{$self->{'type_check'}} = 1;
|
|
|
227 |
}
|
|
|
228 |
}
|
| 217 |
bj |
229 |
elsif ($values[0] eq '=') {
|
| 107 |
bj |
230 |
if (defined $validNames{$values[1]}) {
|
|
|
231 |
$self->process_assignment($values[1], $values[2]);
|
|
|
232 |
}
|
|
|
233 |
else {
|
|
|
234 |
$error = "Invalid assignment name: $values[1]";
|
|
|
235 |
$status = 0;
|
|
|
236 |
}
|
|
|
237 |
}
|
| 217 |
bj |
238 |
elsif ($values[0] eq '+=') {
|
| 107 |
bj |
239 |
if (defined $validNames{$values[1]}) {
|
|
|
240 |
$self->process_assignment_add($values[1], $values[2]);
|
|
|
241 |
}
|
|
|
242 |
else {
|
|
|
243 |
$error = "Invalid addition name: $values[1]";
|
|
|
244 |
$status = 0;
|
|
|
245 |
}
|
|
|
246 |
}
|
| 217 |
bj |
247 |
elsif ($values[0] eq '-=') {
|
| 107 |
bj |
248 |
if (defined $validNames{$values[1]}) {
|
|
|
249 |
$self->process_assignment_sub($values[1], $values[2]);
|
|
|
250 |
}
|
|
|
251 |
else {
|
|
|
252 |
$error = "Invalid subtraction name: $values[1]";
|
|
|
253 |
$status = 0;
|
|
|
254 |
}
|
|
|
255 |
}
|
|
|
256 |
elsif ($values[0] eq 'component') {
|
|
|
257 |
($status, $error) = $self->parse_scope($ih,
|
|
|
258 |
$values[1],
|
|
|
259 |
$values[2],
|
|
|
260 |
\%validNames);
|
|
|
261 |
}
|
|
|
262 |
else {
|
|
|
263 |
$error = "Unrecognized line: $line";
|
|
|
264 |
$status = 0;
|
|
|
265 |
}
|
|
|
266 |
}
|
|
|
267 |
elsif ($status == -1) {
|
| 217 |
bj |
268 |
foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) :
|
|
|
269 |
$line) {
|
|
|
270 |
if ($expfile =~ /\.$wsext$/) {
|
|
|
271 |
($status, $error) = $self->aggregated_workspace($expfile);
|
|
|
272 |
last if (!$status);
|
|
|
273 |
}
|
|
|
274 |
else {
|
|
|
275 |
push(@{$self->{'project_files'}}, $expfile);
|
|
|
276 |
$status = 1;
|
|
|
277 |
}
|
| 107 |
bj |
278 |
}
|
|
|
279 |
}
|
|
|
280 |
|
|
|
281 |
return $status, $error;
|
|
|
282 |
}
|
|
|
283 |
|
|
|
284 |
|
|
|
285 |
sub aggregated_workspace {
|
|
|
286 |
my($self) = shift;
|
|
|
287 |
my($file) = shift;
|
|
|
288 |
my($fh) = new FileHandle();
|
|
|
289 |
|
|
|
290 |
if (open($fh, $file)) {
|
|
|
291 |
my($oline) = $self->get_line_number();
|
|
|
292 |
my($tc) = $self->{$self->{'type_check'}};
|
|
|
293 |
my($ag) = $self->{'handled_scopes'}->{$aggregated};
|
|
|
294 |
my($psbd) = $self->{'scoped_basedir'};
|
|
|
295 |
my($status, $error, @values) = (0, 'No recognizable lines');
|
|
|
296 |
|
|
|
297 |
$self->{'handled_scopes'}->{$aggregated} = undef;
|
|
|
298 |
$self->set_line_number(0);
|
|
|
299 |
$self->{$self->{'type_check'}} = 0;
|
|
|
300 |
$self->{'scoped_basedir'} = $self->mpc_dirname($file);
|
|
|
301 |
|
|
|
302 |
while(<$fh>) {
|
|
|
303 |
my($line) = $self->preprocess_line($fh, $_);
|
|
|
304 |
($status, $error, @values) = $self->parse_known($line);
|
|
|
305 |
|
|
|
306 |
## Was the line recognized?
|
|
|
307 |
if ($status) {
|
|
|
308 |
if (defined $values[0]) {
|
|
|
309 |
if ($values[0] eq $self->{'grammar_type'}) {
|
|
|
310 |
if (defined $values[2]) {
|
| 217 |
bj |
311 |
my($name) = $self->mpc_basename($file);
|
| 107 |
bj |
312 |
$name =~ s/\.[^\.]+$//;
|
|
|
313 |
$status = 0;
|
|
|
314 |
$error = 'Aggregated workspace (' . $name .
|
|
|
315 |
') can not inherit from another workspace';
|
|
|
316 |
}
|
|
|
317 |
else {
|
|
|
318 |
($status, $error) = $self->parse_scope($fh,
|
|
|
319 |
'',
|
|
|
320 |
$aggregated,
|
|
|
321 |
\%validNames);
|
|
|
322 |
}
|
|
|
323 |
}
|
|
|
324 |
else {
|
|
|
325 |
$status = 0;
|
|
|
326 |
$error = 'Unable to aggregate ' . $file;
|
|
|
327 |
}
|
|
|
328 |
last;
|
|
|
329 |
}
|
|
|
330 |
}
|
|
|
331 |
else {
|
|
|
332 |
last;
|
|
|
333 |
}
|
|
|
334 |
}
|
|
|
335 |
close($fh);
|
|
|
336 |
|
|
|
337 |
$self->{'scoped_basedir'} = $psbd;
|
|
|
338 |
$self->{'handled_scopes'}->{$aggregated} = $ag;
|
|
|
339 |
$self->{$self->{'type_check'}} = $tc;
|
|
|
340 |
$self->set_line_number($oline);
|
|
|
341 |
|
|
|
342 |
return $status, $error;
|
|
|
343 |
}
|
|
|
344 |
|
|
|
345 |
return 0, 'Unable to open ' . $file;
|
|
|
346 |
}
|
|
|
347 |
|
|
|
348 |
|
|
|
349 |
sub parse_scope {
|
|
|
350 |
my($self) = shift;
|
|
|
351 |
my($fh) = shift;
|
|
|
352 |
my($name) = shift;
|
|
|
353 |
my($type) = shift;
|
|
|
354 |
my($validNames) = shift;
|
|
|
355 |
my($flags) = shift;
|
|
|
356 |
my($elseflags) = shift;
|
|
|
357 |
|
|
|
358 |
if ($name eq 'exclude') {
|
|
|
359 |
return $self->parse_exclude($fh, $type);
|
|
|
360 |
}
|
|
|
361 |
else {
|
| 198 |
bj |
362 |
## We need to make a copy of the current assignment hash
|
|
|
363 |
## to ensure that multiply scoped assignments/additions/subtractions
|
|
|
364 |
## work and contain the non-scoped assignments/additions/subtractions
|
|
|
365 |
if (!defined $flags) {
|
|
|
366 |
my(%copy) = %{$self->get_assignment_hash()};
|
|
|
367 |
$flags = \%copy;
|
|
|
368 |
}
|
| 107 |
bj |
369 |
return $self->SUPER::parse_scope($fh, $name, $type,
|
|
|
370 |
$validNames, $flags, $elseflags);
|
|
|
371 |
}
|
|
|
372 |
}
|
|
|
373 |
|
|
|
374 |
sub parse_exclude {
|
|
|
375 |
my($self) = shift;
|
|
|
376 |
my($fh) = shift;
|
|
|
377 |
my($typestr) = shift;
|
|
|
378 |
my($status) = 0;
|
|
|
379 |
my($errorString) = 'Unable to process exclude';
|
|
|
380 |
my($negated) = undef;
|
|
|
381 |
|
|
|
382 |
if ($typestr eq $self->get_default_component_name()) {
|
|
|
383 |
$typestr = $self->{'wctype'};
|
|
|
384 |
}
|
|
|
385 |
|
|
|
386 |
my(@exclude) = ();
|
|
|
387 |
my(%types) = ();
|
|
|
388 |
@types{split(/\s*,\s*/, $typestr)} = ();
|
|
|
389 |
|
|
|
390 |
## If there is a negation at all, add our
|
|
|
391 |
## current type, it may be removed below
|
| 217 |
bj |
392 |
if (index($typestr, '!') >= 0) {
|
| 107 |
bj |
393 |
$negated = 1;
|
|
|
394 |
$types{$self->{wctype}} = 1;
|
|
|
395 |
|
|
|
396 |
## Process negated exclusions
|
|
|
397 |
foreach my $key (keys %types) {
|
|
|
398 |
if ($key =~ /^!\s*(\w+)/) {
|
|
|
399 |
## Remove the negated key
|
|
|
400 |
delete $types{$key};
|
|
|
401 |
|
|
|
402 |
## Then delete the key that was negated in the exclusion.
|
|
|
403 |
delete $types{$1};
|
|
|
404 |
}
|
|
|
405 |
}
|
|
|
406 |
}
|
|
|
407 |
|
|
|
408 |
if (exists $types{$self->{wctype}}) {
|
|
|
409 |
while(<$fh>) {
|
|
|
410 |
my($line) = $self->preprocess_line($fh, $_);
|
|
|
411 |
|
|
|
412 |
if ($line eq '') {
|
|
|
413 |
}
|
|
|
414 |
elsif ($line =~ /^}(.*)$/) {
|
|
|
415 |
if (defined $1 && $1 ne '') {
|
|
|
416 |
$status = 0;
|
|
|
417 |
$errorString = "Trailing characters found: '$1'";
|
|
|
418 |
}
|
|
|
419 |
else {
|
|
|
420 |
$status = 1;
|
|
|
421 |
$errorString = undef;
|
|
|
422 |
}
|
|
|
423 |
last;
|
|
|
424 |
}
|
|
|
425 |
else {
|
| 217 |
bj |
426 |
if ($line =~ /^"([^"]+)"$/) {
|
|
|
427 |
$line = $1;
|
|
|
428 |
}
|
| 107 |
bj |
429 |
if (defined $self->{'scoped_basedir'}) {
|
|
|
430 |
$line = $self->{'scoped_basedir'} . '/' . $line;
|
|
|
431 |
}
|
| 217 |
bj |
432 |
if ($line =~ /[\?\*\[\]]/) {
|
|
|
433 |
push(@exclude, $self->mpc_glob($line));
|
|
|
434 |
}
|
|
|
435 |
else {
|
|
|
436 |
push(@exclude, $line);
|
|
|
437 |
}
|
| 107 |
bj |
438 |
}
|
|
|
439 |
}
|
|
|
440 |
|
|
|
441 |
foreach my $type (keys %types) {
|
|
|
442 |
if (!defined $self->{'exclude'}->{$type}) {
|
|
|
443 |
$self->{'exclude'}->{$type} = [];
|
|
|
444 |
}
|
|
|
445 |
push(@{$self->{'exclude'}->{$type}}, @exclude);
|
|
|
446 |
}
|
|
|
447 |
}
|
|
|
448 |
else {
|
|
|
449 |
if ($negated) {
|
|
|
450 |
($status, $errorString) = $self->SUPER::parse_scope($fh,
|
|
|
451 |
'exclude',
|
|
|
452 |
$typestr,
|
|
|
453 |
\%validNames);
|
|
|
454 |
}
|
|
|
455 |
else {
|
|
|
456 |
## If this exclude block didn't match the current type and the
|
|
|
457 |
## exclude wasn't negated, we need to eat the exclude block so that
|
|
|
458 |
## these lines don't get included into the workspace.
|
|
|
459 |
while(<$fh>) {
|
|
|
460 |
my($line) = $self->preprocess_line($fh, $_);
|
|
|
461 |
|
|
|
462 |
if ($line =~ /^}(.*)$/) {
|
|
|
463 |
if (defined $1 && $1 ne '') {
|
|
|
464 |
$status = 0;
|
|
|
465 |
$errorString = "Trailing characters found: '$1'";
|
|
|
466 |
}
|
|
|
467 |
else {
|
|
|
468 |
$status = 1;
|
|
|
469 |
$errorString = undef;
|
|
|
470 |
}
|
|
|
471 |
last;
|
|
|
472 |
}
|
|
|
473 |
}
|
|
|
474 |
}
|
|
|
475 |
}
|
|
|
476 |
|
|
|
477 |
return $status, $errorString;
|
|
|
478 |
}
|
|
|
479 |
|
|
|
480 |
|
|
|
481 |
sub excluded {
|
|
|
482 |
my($self) = shift;
|
|
|
483 |
my($file) = shift;
|
|
|
484 |
|
|
|
485 |
foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
|
| 217 |
bj |
486 |
if ($excluded eq $file || index($file, "$excluded/") == 0) {
|
| 107 |
bj |
487 |
return 1;
|
|
|
488 |
}
|
|
|
489 |
}
|
|
|
490 |
|
|
|
491 |
return 0;
|
|
|
492 |
}
|
|
|
493 |
|
|
|
494 |
|
|
|
495 |
sub handle_scoped_end {
|
|
|
496 |
my($self) = shift;
|
|
|
497 |
my($type) = shift;
|
|
|
498 |
my($flags) = shift;
|
|
|
499 |
my($status) = 1;
|
|
|
500 |
my($error) = undef;
|
|
|
501 |
|
|
|
502 |
if ($type eq $aggregated &&
|
|
|
503 |
!defined $self->{'handled_scopes'}->{$type}) {
|
|
|
504 |
## Replace instances of $PWD with the current directory plus the
|
|
|
505 |
## scoped_basedir. We have to do it now otherwise, $PWD will be the
|
|
|
506 |
## wrong directory if it's done later.
|
|
|
507 |
if (defined $$flags{'cmdline'}) {
|
|
|
508 |
my($dir) = $self->getcwd() . '/' . $self->{'scoped_basedir'};
|
|
|
509 |
$$flags{'cmdline'} =~ s/\$PWD(\W)/$dir$1/g;
|
|
|
510 |
$$flags{'cmdline'} =~ s/\$PWD$/$dir/;
|
|
|
511 |
}
|
|
|
512 |
|
|
|
513 |
## Go back to the previous directory and add the directory contents
|
|
|
514 |
($status, $error) = $self->handle_scoped_unknown(undef, $type, $flags, '.');
|
|
|
515 |
}
|
|
|
516 |
|
|
|
517 |
$self->{'handled_scopes'}->{$type} = undef;
|
|
|
518 |
return $status, $error;
|
|
|
519 |
}
|
|
|
520 |
|
|
|
521 |
|
|
|
522 |
sub handle_scoped_unknown {
|
|
|
523 |
my($self) = shift;
|
|
|
524 |
my($fh) = shift;
|
|
|
525 |
my($type) = shift;
|
|
|
526 |
my($flags) = shift;
|
|
|
527 |
my($line) = shift;
|
|
|
528 |
my($status) = 1;
|
|
|
529 |
my($error) = undef;
|
|
|
530 |
my($dupchk) = undef;
|
|
|
531 |
|
|
|
532 |
if ($line =~ /^\w+.*{/) {
|
|
|
533 |
if (defined $fh) {
|
|
|
534 |
my(@values) = ();
|
|
|
535 |
my($tc) = $self->{$self->{'type_check'}};
|
|
|
536 |
$self->{$self->{'type_check'}} = 1;
|
|
|
537 |
($status, $error, @values) = $self->parse_line($fh, $line);
|
|
|
538 |
$self->{$self->{'type_check'}} = $tc;
|
|
|
539 |
}
|
|
|
540 |
else {
|
|
|
541 |
$status = 0;
|
|
|
542 |
$error = 'Unhandled line: ' . $line;
|
|
|
543 |
}
|
|
|
544 |
return $status, $error;
|
|
|
545 |
}
|
|
|
546 |
|
|
|
547 |
if ($type eq $aggregated) {
|
|
|
548 |
$line = $self->{'scoped_basedir'} . ($line ne '.' ? "/$line" : '');
|
|
|
549 |
my(%dup) = ();
|
|
|
550 |
@dup{@{$self->{'project_files'}}} = ();
|
|
|
551 |
$dupchk = \%dup;
|
|
|
552 |
}
|
|
|
553 |
|
|
|
554 |
if (-d $line) {
|
|
|
555 |
my(@files) = ();
|
|
|
556 |
$self->search_for_files([ $line ], \@files, $$flags{'implicit'});
|
|
|
557 |
|
|
|
558 |
## If we are generating implicit projects within a scope, then
|
|
|
559 |
## we need to remove directories and the parent directories for which
|
|
|
560 |
## there is an mpc file. Otherwise, the projects will be added
|
|
|
561 |
## twice.
|
|
|
562 |
if ($$flags{'implicit'}) {
|
|
|
563 |
my(%remove) = ();
|
|
|
564 |
foreach my $file (@files) {
|
|
|
565 |
if ($file =~ /\.mpc$/) {
|
|
|
566 |
my($exc) = $file;
|
|
|
567 |
do {
|
|
|
568 |
$exc = $self->mpc_dirname($exc);
|
|
|
569 |
$remove{$exc} = 1;
|
|
|
570 |
} while($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i);
|
|
|
571 |
}
|
|
|
572 |
}
|
|
|
573 |
|
|
|
574 |
my(@acceptable) = ();
|
|
|
575 |
foreach my $file (@files) {
|
|
|
576 |
if (!defined $remove{$file}) {
|
|
|
577 |
push(@acceptable, $file);
|
|
|
578 |
}
|
|
|
579 |
}
|
|
|
580 |
@files = @acceptable;
|
|
|
581 |
}
|
|
|
582 |
|
|
|
583 |
foreach my $file (@files) {
|
|
|
584 |
if (!$self->excluded($file)) {
|
|
|
585 |
if (defined $dupchk && exists $$dupchk{$file}) {
|
|
|
586 |
$self->warning("Duplicate mpc file ($file) added by an " .
|
|
|
587 |
'aggregate workspace. It will be ignored.');
|
|
|
588 |
}
|
|
|
589 |
else {
|
|
|
590 |
$self->{'scoped_assign'}->{$file} = $flags;
|
|
|
591 |
push(@{$self->{'project_files'}}, $file);
|
|
|
592 |
}
|
|
|
593 |
}
|
|
|
594 |
}
|
|
|
595 |
}
|
|
|
596 |
else {
|
| 217 |
bj |
597 |
foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) :
|
|
|
598 |
$line) {
|
|
|
599 |
if ($expfile =~ /\.$wsext$/) {
|
|
|
600 |
## An aggregated workspace within an aggregated workspace.
|
|
|
601 |
($status, $error) = $self->aggregated_workspace($expfile);
|
|
|
602 |
last if (!$status);
|
|
|
603 |
}
|
|
|
604 |
else {
|
|
|
605 |
if (!$self->excluded($expfile)) {
|
|
|
606 |
if (defined $dupchk && exists $$dupchk{$expfile}) {
|
|
|
607 |
$self->warning("Duplicate mpc file ($expfile) added by an " .
|
|
|
608 |
'aggregate workspace. It will be ignored.');
|
|
|
609 |
}
|
|
|
610 |
else {
|
|
|
611 |
$self->{'scoped_assign'}->{$expfile} = $flags;
|
|
|
612 |
push(@{$self->{'project_files'}}, $expfile);
|
|
|
613 |
}
|
| 107 |
bj |
614 |
}
|
|
|
615 |
}
|
|
|
616 |
}
|
|
|
617 |
}
|
|
|
618 |
$self->{'handled_scopes'}->{$type} = 1;
|
|
|
619 |
|
|
|
620 |
return $status, $error;
|
|
|
621 |
}
|
|
|
622 |
|
|
|
623 |
|
|
|
624 |
sub search_for_files {
|
| 217 |
bj |
625 |
my($self) = shift;
|
|
|
626 |
my($files) = shift;
|
|
|
627 |
my($array) = shift;
|
|
|
628 |
my($impl) = shift;
|
|
|
629 |
my($excluded) = 0;
|
| 107 |
bj |
630 |
|
|
|
631 |
foreach my $file (@$files) {
|
|
|
632 |
if (-d $file) {
|
|
|
633 |
my(@f) = $self->generate_default_file_list(
|
|
|
634 |
$file,
|
| 217 |
bj |
635 |
$self->{'exclude'}->{$self->{'wctype'}},
|
|
|
636 |
\$excluded);
|
| 107 |
bj |
637 |
$self->search_for_files(\@f, $array, $impl);
|
|
|
638 |
if ($impl) {
|
|
|
639 |
$file =~ s/^\.\///;
|
|
|
640 |
unshift(@$array, $file);
|
|
|
641 |
}
|
|
|
642 |
}
|
|
|
643 |
else {
|
|
|
644 |
if ($file =~ /\.mpc$/) {
|
|
|
645 |
$file =~ s/^\.\///;
|
|
|
646 |
unshift(@$array, $file);
|
|
|
647 |
}
|
|
|
648 |
}
|
|
|
649 |
}
|
| 217 |
bj |
650 |
|
|
|
651 |
return $excluded;
|
| 107 |
bj |
652 |
}
|
|
|
653 |
|
|
|
654 |
|
|
|
655 |
sub remove_duplicate_projects {
|
|
|
656 |
my($self) = shift;
|
|
|
657 |
my($list) = shift;
|
|
|
658 |
my($count) = scalar(@$list);
|
|
|
659 |
|
|
|
660 |
for(my $i = 0; $i < $count; ++$i) {
|
|
|
661 |
my($file) = $$list[$i];
|
|
|
662 |
foreach my $inner (@$list) {
|
| 217 |
bj |
663 |
if ($file ne $inner &&
|
|
|
664 |
$file eq $self->mpc_dirname($inner) && ! -d $inner) {
|
| 107 |
bj |
665 |
splice(@$list, $i, 1);
|
|
|
666 |
--$count;
|
|
|
667 |
--$i;
|
|
|
668 |
last;
|
|
|
669 |
}
|
|
|
670 |
}
|
|
|
671 |
}
|
|
|
672 |
}
|
|
|
673 |
|
|
|
674 |
|
|
|
675 |
sub generate_default_components {
|
| 217 |
bj |
676 |
my($self) = shift;
|
|
|
677 |
my($files) = shift;
|
|
|
678 |
my($impl) = shift;
|
|
|
679 |
my($excluded) = shift;
|
|
|
680 |
my($pjf) = $self->{'project_files'};
|
| 107 |
bj |
681 |
|
|
|
682 |
if (defined $$pjf[0]) {
|
|
|
683 |
## If we have files, then process directories
|
|
|
684 |
my(@built) = ();
|
|
|
685 |
foreach my $file (@$pjf) {
|
|
|
686 |
if (!$self->excluded($file)) {
|
|
|
687 |
if (-d $file) {
|
|
|
688 |
my(@found) = ();
|
|
|
689 |
my(@gen) = $self->generate_default_file_list(
|
|
|
690 |
$file,
|
|
|
691 |
$self->{'exclude'}->{$self->{'wctype'}});
|
|
|
692 |
$self->search_for_files(\@gen, \@found, $impl);
|
|
|
693 |
push(@built, @found);
|
|
|
694 |
if ($impl || $self->{'scoped_assign'}->{$file}->{'implicit'}) {
|
|
|
695 |
push(@built, $file);
|
|
|
696 |
}
|
|
|
697 |
}
|
|
|
698 |
else {
|
|
|
699 |
push(@built, $file);
|
|
|
700 |
}
|
|
|
701 |
}
|
|
|
702 |
}
|
|
|
703 |
|
|
|
704 |
## If the workspace is set to implicit
|
|
|
705 |
if ($impl) {
|
|
|
706 |
## Remove duplicates from this list
|
|
|
707 |
$self->remove_duplicate_projects(\@built);
|
|
|
708 |
}
|
|
|
709 |
|
|
|
710 |
## Set the project files
|
|
|
711 |
$self->{'project_files'} = \@built;
|
|
|
712 |
}
|
|
|
713 |
else {
|
|
|
714 |
## Add all of the wanted files in this directory
|
|
|
715 |
## and in the subdirectories.
|
| 217 |
bj |
716 |
$excluded |= $self->search_for_files($files, $pjf, $impl);
|
| 107 |
bj |
717 |
|
|
|
718 |
## If the workspace is set to implicit
|
|
|
719 |
if ($impl) {
|
|
|
720 |
## Remove duplicates from this list
|
|
|
721 |
$self->remove_duplicate_projects($pjf);
|
|
|
722 |
}
|
|
|
723 |
|
|
|
724 |
## If no files were found, then we push the empty
|
|
|
725 |
## string, so the Project Creator will generate
|
|
|
726 |
## the default project file.
|
| 217 |
bj |
727 |
if (!defined $$pjf[0] && !$excluded) {
|
| 107 |
bj |
728 |
push(@$pjf, '');
|
|
|
729 |
}
|
|
|
730 |
}
|
|
|
731 |
}
|
|
|
732 |
|
|
|
733 |
|
|
|
734 |
sub get_default_workspace_name {
|
|
|
735 |
my($self) = shift;
|
|
|
736 |
my($name) = $self->{'current_input'};
|
|
|
737 |
|
|
|
738 |
if ($name eq '') {
|
|
|
739 |
$name = $self->base_directory();
|
|
|
740 |
}
|
|
|
741 |
else {
|
|
|
742 |
## Since files on UNIX can have back slashes, we transform them
|
|
|
743 |
## into underscores.
|
|
|
744 |
$name =~ s/\\/_/g;
|
|
|
745 |
|
|
|
746 |
## Take off the extension
|
|
|
747 |
$name =~ s/\.[^\.]+$//;
|
|
|
748 |
}
|
|
|
749 |
|
|
|
750 |
return $name;
|
|
|
751 |
}
|
|
|
752 |
|
|
|
753 |
|
|
|
754 |
sub generate_defaults {
|
|
|
755 |
my($self) = shift;
|
|
|
756 |
|
|
|
757 |
## Generate default workspace name
|
|
|
758 |
if (!defined $self->{'workspace_name'}) {
|
|
|
759 |
$self->{'workspace_name'} = $self->get_default_workspace_name();
|
|
|
760 |
}
|
|
|
761 |
|
| 217 |
bj |
762 |
## Modify the exclude list if we have changed directory from the original
|
|
|
763 |
## starting directory. Just take off the difference from the front.
|
|
|
764 |
my(@original) = ();
|
|
|
765 |
my($top) = $self->getcwd() . '/';
|
|
|
766 |
my($start) = $self->getstartdir() . '/';
|
|
|
767 |
|
|
|
768 |
if ($start ne $top && $top =~ s/^$start//) {
|
|
|
769 |
foreach my $exclude (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
|
|
|
770 |
push(@original, $exclude);
|
|
|
771 |
$exclude =~ s/^$top//;
|
|
|
772 |
}
|
|
|
773 |
}
|
|
|
774 |
|
|
|
775 |
my($excluded) = 0;
|
| 107 |
bj |
776 |
my(@files) = $self->generate_default_file_list(
|
|
|
777 |
'.',
|
| 217 |
bj |
778 |
$self->{'exclude'}->{$self->{'wctype'}},
|
|
|
779 |
\$excluded);
|
| 107 |
bj |
780 |
|
|
|
781 |
## Generate default components
|
|
|
782 |
$self->generate_default_components(\@files,
|
| 217 |
bj |
783 |
$self->get_assignment('implicit'),
|
|
|
784 |
$excluded);
|
|
|
785 |
|
|
|
786 |
## Return the actual exclude list of we modified it
|
|
|
787 |
if (defined $original[0]) {
|
|
|
788 |
$self->{'exclude'}->{$self->{'wctype'}} = \@original;
|
|
|
789 |
}
|
| 107 |
bj |
790 |
}
|
|
|
791 |
|
|
|
792 |
|
|
|
793 |
sub get_workspace_name {
|
|
|
794 |
my($self) = shift;
|
|
|
795 |
return $self->{'workspace_name'};
|
|
|
796 |
}
|
|
|
797 |
|
|
|
798 |
|
|
|
799 |
sub get_current_output_name {
|
|
|
800 |
my($self) = shift;
|
|
|
801 |
return $self->{'current_output'};
|
|
|
802 |
}
|
|
|
803 |
|
|
|
804 |
|
|
|
805 |
sub write_workspace {
|
|
|
806 |
my($self) = shift;
|
|
|
807 |
my($creator) = shift;
|
|
|
808 |
my($addfile) = shift;
|
|
|
809 |
my($status) = 1;
|
|
|
810 |
my($error) = undef;
|
|
|
811 |
my($duplicates) = 0;
|
|
|
812 |
|
|
|
813 |
if ($self->get_toplevel()) {
|
|
|
814 |
my($progress) = $self->get_progress_callback();
|
|
|
815 |
|
|
|
816 |
if (defined $progress) {
|
|
|
817 |
&$progress();
|
|
|
818 |
}
|
|
|
819 |
|
|
|
820 |
if ($addfile) {
|
|
|
821 |
## To be consistent across multiple project types, we disallow
|
|
|
822 |
## duplicate project names for all types, not just VC6.
|
|
|
823 |
## Note that these name are handled case-insensitive by VC6
|
|
|
824 |
my(%names) = ();
|
|
|
825 |
foreach my $project (@{$self->{'projects'}}) {
|
|
|
826 |
my($name) = lc($self->{'project_info'}->{$project}->[0]);
|
|
|
827 |
if (defined $names{$name}) {
|
|
|
828 |
++$duplicates;
|
|
|
829 |
$self->error("Duplicate case-insensitive project '$name'. " .
|
| 217 |
bj |
830 |
"Look in " . $self->mpc_dirname($project) .
|
|
|
831 |
" and " . $self->mpc_dirname($names{$name}) .
|
| 107 |
bj |
832 |
" for project name conflicts.");
|
|
|
833 |
}
|
|
|
834 |
else {
|
|
|
835 |
$names{$name} = $project;
|
|
|
836 |
}
|
|
|
837 |
}
|
|
|
838 |
}
|
|
|
839 |
else {
|
|
|
840 |
$self->{'per_project_workspace_name'} = 1;
|
|
|
841 |
}
|
|
|
842 |
|
|
|
843 |
my($name) = $self->transform_file_name($self->workspace_file_name());
|
|
|
844 |
my($outdir) = $self->get_outdir();
|
|
|
845 |
my($oname) = $name;
|
|
|
846 |
|
|
|
847 |
$name = "$outdir/$name";
|
|
|
848 |
|
|
|
849 |
my($abort_creation) = 0;
|
|
|
850 |
if ($duplicates > 0) {
|
|
|
851 |
$abort_creation = 1;
|
|
|
852 |
$error = "Duplicate case-insensitive project names are " .
|
|
|
853 |
"not allowed within a workspace.";
|
|
|
854 |
$status = 0;
|
|
|
855 |
}
|
|
|
856 |
else {
|
|
|
857 |
if (!defined $self->{'projects'}->[0]) {
|
|
|
858 |
$self->information('No projects were created.');
|
|
|
859 |
$abort_creation = 1;
|
|
|
860 |
}
|
|
|
861 |
}
|
|
|
862 |
|
|
|
863 |
if (!$abort_creation) {
|
|
|
864 |
my($fh) = new FileHandle();
|
|
|
865 |
my($dir) = $self->mpc_dirname($name);
|
|
|
866 |
|
|
|
867 |
## Verify and possibly modify the dependencies
|
|
|
868 |
if ($addfile) {
|
|
|
869 |
$self->verify_build_ordering();
|
|
|
870 |
}
|
|
|
871 |
|
|
|
872 |
if ($dir ne '.') {
|
|
|
873 |
mkpath($dir, 0, 0777);
|
|
|
874 |
}
|
|
|
875 |
|
|
|
876 |
if ($addfile || !$self->file_written($name)) {
|
|
|
877 |
$self->{'current_output'} = $name;
|
|
|
878 |
if ($self->compare_output()) {
|
|
|
879 |
## First write the output to a temporary file
|
|
|
880 |
my($tmp) = "$outdir/MWC$>.$$";
|
|
|
881 |
my($different) = 1;
|
|
|
882 |
if (open($fh, ">$tmp")) {
|
|
|
883 |
$self->pre_workspace($fh);
|
|
|
884 |
$self->write_comps($fh, $creator, $addfile);
|
|
|
885 |
$self->post_workspace($fh);
|
|
|
886 |
close($fh);
|
|
|
887 |
|
|
|
888 |
if (-r $name &&
|
|
|
889 |
-s $tmp == -s $name && compare($tmp, $name) == 0) {
|
|
|
890 |
$different = 0;
|
|
|
891 |
}
|
|
|
892 |
}
|
|
|
893 |
else {
|
|
|
894 |
$error = "Unable to open $tmp for output.";
|
|
|
895 |
$status = 0;
|
|
|
896 |
}
|
|
|
897 |
|
|
|
898 |
if ($status) {
|
|
|
899 |
if ($different) {
|
|
|
900 |
unlink($name);
|
|
|
901 |
if (rename($tmp, $name)) {
|
|
|
902 |
if ($addfile) {
|
|
|
903 |
$self->add_file_written($oname);
|
|
|
904 |
}
|
|
|
905 |
}
|
|
|
906 |
else {
|
|
|
907 |
$error = 'Unable to open ' . $self->getcwd() .
|
|
|
908 |
"/$name for output";
|
|
|
909 |
$status = 0;
|
|
|
910 |
}
|
|
|
911 |
}
|
|
|
912 |
else {
|
|
|
913 |
## We will pretend that we wrote the file
|
|
|
914 |
unlink($tmp);
|
|
|
915 |
if ($addfile) {
|
|
|
916 |
$self->add_file_written($oname);
|
|
|
917 |
}
|
|
|
918 |
}
|
|
|
919 |
}
|
|
|
920 |
}
|
|
|
921 |
else {
|
|
|
922 |
if (open($fh, ">$name")) {
|
|
|
923 |
$self->pre_workspace($fh);
|
|
|
924 |
$self->write_comps($fh, $creator, $addfile);
|
|
|
925 |
$self->post_workspace($fh);
|
|
|
926 |
close($fh);
|
|
|
927 |
|
|
|
928 |
if ($addfile) {
|
|
|
929 |
$self->add_file_written($oname);
|
|
|
930 |
}
|
|
|
931 |
}
|
|
|
932 |
else {
|
|
|
933 |
$error = "Unable to open $name for output.";
|
|
|
934 |
$status = 0;
|
|
|
935 |
}
|
|
|
936 |
}
|
|
|
937 |
}
|
|
|
938 |
}
|
|
|
939 |
|
|
|
940 |
if (!$addfile) {
|
|
|
941 |
$self->{'per_project_workspace_name'} = undef;
|
|
|
942 |
}
|
|
|
943 |
}
|
|
|
944 |
|
|
|
945 |
return $status, $error;
|
|
|
946 |
}
|
|
|
947 |
|
|
|
948 |
|
|
|
949 |
sub save_project_info {
|
|
|
950 |
my($self) = shift;
|
|
|
951 |
my($gen) = shift;
|
|
|
952 |
my($gpi) = shift;
|
|
|
953 |
my($gll) = shift;
|
|
|
954 |
my($dir) = shift;
|
|
|
955 |
my($projects) = shift;
|
|
|
956 |
my($pi) = shift;
|
|
|
957 |
my($ll) = shift;
|
|
|
958 |
my($c) = 0;
|
|
|
959 |
|
|
|
960 |
## For each file written
|
|
|
961 |
foreach my $pj (@$gen) {
|
|
|
962 |
## Save the full path to the project file in the array
|
|
|
963 |
my($full) = ($dir ne '.' ? "$dir/" : '') . $pj;
|
|
|
964 |
push(@$projects, $full);
|
|
|
965 |
|
|
|
966 |
## Get the corresponding generated project info and save it
|
|
|
967 |
## in the hash map keyed on the full project file name
|
|
|
968 |
$$pi{$full} = $$gpi[$c];
|
|
|
969 |
$c++;
|
|
|
970 |
}
|
|
|
971 |
|
|
|
972 |
foreach my $key (keys %$gll) {
|
|
|
973 |
$$ll{$key} = $$gll{$key};
|
|
|
974 |
}
|
|
|
975 |
}
|
|
|
976 |
|
|
|
977 |
|
|
|
978 |
sub topname {
|
|
|
979 |
my($self) = shift;
|
|
|
980 |
my($file) = shift;
|
|
|
981 |
my($dir) = '.';
|
|
|
982 |
my($rest) = $file;
|
|
|
983 |
if ($file =~ /^([^\/\\]+)[\/\\](.*)/) {
|
|
|
984 |
$dir = $1;
|
|
|
985 |
$rest = $2;
|
|
|
986 |
}
|
|
|
987 |
return $dir, $rest;
|
|
|
988 |
}
|
|
|
989 |
|
|
|
990 |
|
|
|
991 |
sub generate_hierarchy {
|
|
|
992 |
my($self) = shift;
|
|
|
993 |
my($creator) = shift;
|
|
|
994 |
my($origproj) = shift;
|
|
|
995 |
my($originfo) = shift;
|
|
|
996 |
my($current) = undef;
|
|
|
997 |
my(@saved) = ();
|
|
|
998 |
my(%sinfo) = ();
|
|
|
999 |
my($cwd) = $self->getcwd();
|
|
|
1000 |
|
|
|
1001 |
## Make a copy of these. We will be modifying them.
|
|
|
1002 |
## It is necessary to sort the projects to get the correct ordering.
|
|
|
1003 |
## Projects in the current directory must come before projects in
|
|
|
1004 |
## other directories.
|
| 198 |
bj |
1005 |
my(@projects) = sort { return $self->sort_projects_by_directory($a, $b) + 0;
|
| 107 |
bj |
1006 |
} @{$origproj};
|
|
|
1007 |
my(%projinfo) = %{$originfo};
|
|
|
1008 |
|
|
|
1009 |
foreach my $prj (@projects) {
|
|
|
1010 |
my($top, $rest) = $self->topname($prj);
|
|
|
1011 |
|
|
|
1012 |
if (!defined $current) {
|
|
|
1013 |
$current = $top;
|
|
|
1014 |
push(@saved, $rest);
|
|
|
1015 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
1016 |
}
|
|
|
1017 |
elsif ($top ne $current) {
|
|
|
1018 |
if ($current ne '.') {
|
|
|
1019 |
## Write out the hierachical workspace
|
|
|
1020 |
$self->cd($current);
|
|
|
1021 |
$self->generate_hierarchy($creator, \@saved, \%sinfo);
|
|
|
1022 |
|
|
|
1023 |
$self->{'projects'} = \@saved;
|
|
|
1024 |
$self->{'project_info'} = \%sinfo;
|
|
|
1025 |
$self->{'workspace_name'} = $self->base_directory();
|
|
|
1026 |
|
|
|
1027 |
my($status, $error) = $self->write_workspace($creator);
|
|
|
1028 |
if (!$status) {
|
|
|
1029 |
$self->error($error);
|
|
|
1030 |
}
|
|
|
1031 |
$self->cd($cwd);
|
|
|
1032 |
}
|
|
|
1033 |
|
|
|
1034 |
## Start the next one
|
|
|
1035 |
$current = $top;
|
|
|
1036 |
@saved = ($rest);
|
|
|
1037 |
%sinfo = ();
|
|
|
1038 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
1039 |
}
|
|
|
1040 |
else {
|
|
|
1041 |
push(@saved, $rest);
|
|
|
1042 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
1043 |
}
|
|
|
1044 |
}
|
|
|
1045 |
if (defined $current && $current ne '.') {
|
|
|
1046 |
$self->cd($current);
|
|
|
1047 |
$self->generate_hierarchy($creator, \@saved, \%sinfo);
|
|
|
1048 |
|
|
|
1049 |
$self->{'projects'} = \@saved;
|
|
|
1050 |
$self->{'project_info'} = \%sinfo;
|
|
|
1051 |
$self->{'workspace_name'} = $self->base_directory();
|
|
|
1052 |
|
|
|
1053 |
my($status, $error) = $self->write_workspace($creator);
|
|
|
1054 |
if (!$status) {
|
|
|
1055 |
$self->error($error);
|
|
|
1056 |
}
|
|
|
1057 |
$self->cd($cwd);
|
|
|
1058 |
}
|
|
|
1059 |
}
|
|
|
1060 |
|
|
|
1061 |
|
|
|
1062 |
sub generate_project_files {
|
|
|
1063 |
my($self) = shift;
|
|
|
1064 |
my($status) = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0);
|
|
|
1065 |
my(@projects) = ();
|
|
|
1066 |
my(%pi) = ();
|
|
|
1067 |
my(%liblocs) = ();
|
|
|
1068 |
my($creator) = $self->project_creator();
|
|
|
1069 |
my($cwd) = $self->getcwd();
|
|
|
1070 |
my($impl) = $self->get_assignment('implicit');
|
|
|
1071 |
my($postkey) = $creator->get_dynamic() .
|
|
|
1072 |
$creator->get_static() . "-$self";
|
|
|
1073 |
my($previmpl) = $impl;
|
|
|
1074 |
my($prevcache) = $self->{'cacheok'};
|
|
|
1075 |
my(%gstate) = $creator->save_state();
|
|
|
1076 |
my($genimpdep) = $self->generate_implicit_project_dependencies();
|
|
|
1077 |
|
|
|
1078 |
## Remove the address portion of the $self string
|
|
|
1079 |
$postkey =~ s/=.*//;
|
|
|
1080 |
|
|
|
1081 |
## Set the source file callback on our project creator
|
|
|
1082 |
$creator->set_source_listing_callback([\&source_listing_callback, $self]);
|
|
|
1083 |
|
|
|
1084 |
foreach my $ofile (@{$self->{'project_files'}}) {
|
|
|
1085 |
if (!$self->excluded($ofile)) {
|
|
|
1086 |
my($file) = $ofile;
|
|
|
1087 |
my($dir) = $self->mpc_dirname($file);
|
|
|
1088 |
my($restore) = 0;
|
|
|
1089 |
|
|
|
1090 |
if (defined $self->{'scoped_assign'}->{$ofile}) {
|
|
|
1091 |
## Handle the implicit assignment
|
|
|
1092 |
my($oi) = $self->{'scoped_assign'}->{$ofile}->{'implicit'};
|
|
|
1093 |
if (defined $oi) {
|
|
|
1094 |
$previmpl = $impl;
|
|
|
1095 |
$impl = $oi;
|
|
|
1096 |
}
|
|
|
1097 |
|
|
|
1098 |
## Handle the cmdline assignment
|
|
|
1099 |
my($cmdline) = $self->{'scoped_assign'}->{$ofile}->{'cmdline'};
|
|
|
1100 |
if (defined $cmdline && $cmdline ne '') {
|
|
|
1101 |
## Save the cacheok value
|
|
|
1102 |
$prevcache = $self->{'cacheok'};
|
|
|
1103 |
|
|
|
1104 |
## Get the current parameters and process the command line
|
|
|
1105 |
my(%parameters) = $self->current_parameters();
|
|
|
1106 |
$self->process_cmdline($cmdline, \%parameters);
|
|
|
1107 |
|
|
|
1108 |
## Set the parameters on the creator
|
|
|
1109 |
$creator->restore_state(\%parameters);
|
|
|
1110 |
$restore = 1;
|
|
|
1111 |
}
|
|
|
1112 |
}
|
|
|
1113 |
|
|
|
1114 |
## If we are generating implicit projects and the file is a
|
|
|
1115 |
## directory, then we set the dir to the file and empty the file
|
|
|
1116 |
if ($impl && -d $file) {
|
|
|
1117 |
$dir = $file;
|
|
|
1118 |
$file = '';
|
|
|
1119 |
|
|
|
1120 |
## If the implicit assignment value was not a number, then
|
|
|
1121 |
## we will add this value to our base projects.
|
|
|
1122 |
if ($impl !~ /^\d+$/) {
|
|
|
1123 |
my($bps) = $creator->get_baseprojs();
|
|
|
1124 |
push(@$bps, split(/\s+/, $impl));
|
|
|
1125 |
$restore = 1;
|
|
|
1126 |
$self->{'cacheok'} = 0;
|
|
|
1127 |
}
|
|
|
1128 |
}
|
|
|
1129 |
|
|
|
1130 |
## Generate the key for this project file
|
|
|
1131 |
my($prkey) = $self->getcwd() . '/' .
|
|
|
1132 |
($file eq '' ? $dir : $file) . "-$postkey";
|
|
|
1133 |
|
|
|
1134 |
## We must change to the subdirectory for
|
|
|
1135 |
## which this project file is intended
|
|
|
1136 |
if ($self->cd($dir)) {
|
|
|
1137 |
my($files_written) = [];
|
|
|
1138 |
my($gen_proj_info) = [];
|
|
|
1139 |
my($gen_lib_locs) = {};
|
|
|
1140 |
if ($self->{'cacheok'} && defined $allprojects{$prkey}) {
|
|
|
1141 |
$files_written = $allprojects{$prkey};
|
|
|
1142 |
$gen_proj_info = $allprinfo{$prkey};
|
|
|
1143 |
$gen_lib_locs = $allliblocs{$prkey};
|
|
|
1144 |
$status = 1;
|
|
|
1145 |
}
|
|
|
1146 |
else {
|
| 217 |
bj |
1147 |
$status = $creator->generate($self->mpc_basename($file));
|
| 107 |
bj |
1148 |
|
|
|
1149 |
## If any one project file fails, then stop
|
|
|
1150 |
## processing altogether.
|
|
|
1151 |
if (!$status) {
|
|
|
1152 |
## We don't restore the state before we leave,
|
| 198 |
bj |
1153 |
## but that's ok since we will be exiting right now.
|
|
|
1154 |
return $status, $creator,
|
|
|
1155 |
"Unable to process " . ($file eq '' ? " in $dir" : $file);
|
| 107 |
bj |
1156 |
}
|
|
|
1157 |
|
|
|
1158 |
## Get the individual project information and
|
|
|
1159 |
## generated file name(s)
|
|
|
1160 |
$files_written = $creator->get_files_written();
|
|
|
1161 |
$gen_proj_info = $creator->get_project_info();
|
|
|
1162 |
$gen_lib_locs = $creator->get_lib_locations();
|
|
|
1163 |
|
|
|
1164 |
if ($self->{'cacheok'}) {
|
|
|
1165 |
$allprojects{$prkey} = $files_written;
|
|
|
1166 |
$allprinfo{$prkey} = $gen_proj_info;
|
|
|
1167 |
$allliblocs{$prkey} = $gen_lib_locs;
|
|
|
1168 |
}
|
|
|
1169 |
}
|
|
|
1170 |
$self->cd($cwd);
|
|
|
1171 |
$self->save_project_info($files_written, $gen_proj_info,
|
|
|
1172 |
$gen_lib_locs, $dir,
|
|
|
1173 |
\@projects, \%pi, \%liblocs);
|
|
|
1174 |
}
|
|
|
1175 |
else {
|
|
|
1176 |
## Unable to change to the directory.
|
|
|
1177 |
## We don't restore the state before we leave,
|
|
|
1178 |
## but that's ok since we will be exiting soon.
|
| 198 |
bj |
1179 |
return 0, $creator, "Unable to change directory to $dir";
|
| 107 |
bj |
1180 |
}
|
|
|
1181 |
|
|
|
1182 |
## Return things to the way they were
|
|
|
1183 |
if (defined $self->{'scoped_assign'}->{$ofile}) {
|
|
|
1184 |
$impl = $previmpl;
|
|
|
1185 |
}
|
|
|
1186 |
if ($restore) {
|
|
|
1187 |
$self->{'cacheok'} = $prevcache;
|
|
|
1188 |
$creator->restore_state(\%gstate);
|
|
|
1189 |
}
|
|
|
1190 |
}
|
|
|
1191 |
else {
|
|
|
1192 |
## This one was excluded, so status is ok
|
|
|
1193 |
$status = 1;
|
|
|
1194 |
}
|
|
|
1195 |
}
|
|
|
1196 |
|
|
|
1197 |
## Add implict project dependencies based on source files
|
|
|
1198 |
## that have been used by multiple projects. If we do it here
|
|
|
1199 |
## before we call generate_hierarchy(), we don't have to call it
|
|
|
1200 |
## in generate_hierarchy() for each workspace.
|
|
|
1201 |
$self->{'projects'} = \@projects;
|
|
|
1202 |
$self->{'project_info'} = \%pi;
|
|
|
1203 |
if ($status && $genimpdep) {
|
|
|
1204 |
$self->add_implicit_project_dependencies($creator, $cwd);
|
|
|
1205 |
}
|
|
|
1206 |
|
|
|
1207 |
## If we are generating the hierarchical workspaces, then do so
|
|
|
1208 |
$self->{'lib_locations'} = \%liblocs;
|
|
|
1209 |
if ($self->get_hierarchy() || $self->workspace_per_project()) {
|
|
|
1210 |
my($orig) = $self->{'workspace_name'};
|
|
|
1211 |
$self->generate_hierarchy($creator, \@projects, \%pi);
|
|
|
1212 |
$self->{'workspace_name'} = $orig;
|
|
|
1213 |
}
|
|
|
1214 |
|
|
|
1215 |
## Reset the projects and project_info
|
|
|
1216 |
$self->{'projects'} = \@projects;
|
|
|
1217 |
$self->{'project_info'} = \%pi;
|
|
|
1218 |
|
|
|
1219 |
return $status, $creator;
|
|
|
1220 |
}
|
|
|
1221 |
|
|
|
1222 |
|
|
|
1223 |
sub array_contains {
|
|
|
1224 |
my($self) = shift;
|
|
|
1225 |
my($left) = shift;
|
|
|
1226 |
my($right) = shift;
|
|
|
1227 |
my(%check) = ();
|
|
|
1228 |
|
|
|
1229 |
## Initialize the hash keys with the left side array
|
|
|
1230 |
@check{@$left} = ();
|
|
|
1231 |
|
|
|
1232 |
## Check each element on the right against the left.
|
|
|
1233 |
foreach my $r (@$right) {
|
|
|
1234 |
if (exists $check{$r}) {
|
|
|
1235 |
return 1;
|
|
|
1236 |
}
|
|
|
1237 |
}
|
|
|
1238 |
|
|
|
1239 |
return 0;
|
|
|
1240 |
}
|
|
|
1241 |
|
|
|
1242 |
|
|
|
1243 |
sub non_intersection {
|
|
|
1244 |
my($self) = shift;
|
|
|
1245 |
my($left) = shift;
|
|
|
1246 |
my($right) = shift;
|
|
|
1247 |
my($over) = shift;
|
|
|
1248 |
my($status) = 0;
|
|
|
1249 |
my(%check) = ();
|
|
|
1250 |
|
|
|
1251 |
## Initialize the hash keys with the left side array
|
|
|
1252 |
@check{@$left} = ();
|
|
|
1253 |
|
|
|
1254 |
## Check each element on the right against the left.
|
|
|
1255 |
## Store anything that isn't in the left side in the over array.
|
|
|
1256 |
foreach my $r (@$right) {
|
|
|
1257 |
if (exists $check{$r}) {
|
|
|
1258 |
$status = 1;
|
|
|
1259 |
}
|
|
|
1260 |
else {
|
|
|
1261 |
push(@$over, $r);
|
|
|
1262 |
}
|
|
|
1263 |
}
|
|
|
1264 |
return $status;
|
|
|
1265 |
}
|
|
|
1266 |
|
|
|
1267 |
|
|
|
1268 |
sub indirect_depdency {
|
|
|
1269 |
my($self) = shift;
|
|
|
1270 |
my($dir) = shift;
|
|
|
1271 |
my($ccheck) = shift;
|
|
|
1272 |
my($cfile) = shift;
|
|
|
1273 |
|
| 217 |
bj |
1274 |
if (index($self->{'project_info'}->{$ccheck}->[1], $cfile) >= 0) {
|
| 107 |
bj |
1275 |
return 1;
|
|
|
1276 |
}
|
|
|
1277 |
else {
|
|
|
1278 |
my($deps) = $self->create_array(
|
|
|
1279 |
$self->{'project_info'}->{$ccheck}->[1]);
|
|
|
1280 |
foreach my $dep (@$deps) {
|
|
|
1281 |
if (defined $self->{'project_info'}->{"$dir$dep"} &&
|
|
|
1282 |
$self->indirect_depdency($dir, "$dir$dep", $cfile)) {
|
|
|
1283 |
return 1;
|
|
|
1284 |
}
|
|
|
1285 |
}
|
|
|
1286 |
}
|
|
|
1287 |
|
|
|
1288 |
return 0;
|
|
|
1289 |
}
|
|
|
1290 |
|
|
|
1291 |
|
|
|
1292 |
sub add_implicit_project_dependencies {
|
|
|
1293 |
my($self) = shift;
|
|
|
1294 |
my($creator) = shift;
|
|
|
1295 |
my($cwd) = shift;
|
|
|
1296 |
my(%bidir) = ();
|
|
|
1297 |
my(%save) = ();
|
|
|
1298 |
|
|
|
1299 |
## Take the current working directory and regular expression'ize it.
|
|
|
1300 |
$cwd = $self->escape_regex_special($cwd);
|
|
|
1301 |
|
|
|
1302 |
## Look at each projects file list and check it against all of the
|
|
|
1303 |
## others. If any of the other projects file lists contains anothers
|
|
|
1304 |
## file, then they are dependent (due to build parallelism). So, we
|
|
|
1305 |
## append the dependency and remove the file in question from the
|
|
|
1306 |
## project so that the next time around the foreach, we don't find it
|
|
|
1307 |
## as a dependent on the one that we just modified.
|
|
|
1308 |
my(@pflkeys) = keys %{$self->{'project_file_list'}};
|
|
|
1309 |
foreach my $key (@pflkeys) {
|
|
|
1310 |
foreach my $ikey (@pflkeys) {
|
|
|
1311 |
## Not the same project and
|
|
|
1312 |
## The same directory and
|
|
|
1313 |
## We've not already added a dependency to this project
|
|
|
1314 |
if ($key ne $ikey &&
|
|
|
1315 |
($self->{'project_file_list'}->{$key}->[1] eq
|
|
|
1316 |
$self->{'project_file_list'}->{$ikey}->[1]) &&
|
|
|
1317 |
(!defined $bidir{$ikey} ||
|
|
|
1318 |
!$self->array_contains($bidir{$ikey}, [$key]))) {
|
|
|
1319 |
my(@over) = ();
|
|
|
1320 |
if ($self->non_intersection(
|
|
|
1321 |
$self->{'project_file_list'}->{$key}->[2],
|
|
|
1322 |
$self->{'project_file_list'}->{$ikey}->[2],
|
|
|
1323 |
\@over)) {
|
|
|
1324 |
## The project contains shared source files, so we need to
|
|
|
1325 |
## look into adding an implicit inter-project dependency.
|
|
|
1326 |
$save{$ikey} = $self->{'project_file_list'}->{$ikey}->[2];
|
|
|
1327 |
$self->{'project_file_list'}->{$ikey}->[2] = \@over;
|
|
|
1328 |
if (defined $bidir{$key}) {
|
|
|
1329 |
push(@{$bidir{$key}}, $ikey);
|
|
|
1330 |
}
|
|
|
1331 |
else {
|
|
|
1332 |
$bidir{$key} = [$ikey];
|
|
|
1333 |
}
|
|
|
1334 |
my($append) = $creator->translate_value('after', $key);
|
|
|
1335 |
my($file) = $self->{'project_file_list'}->{$ikey}->[0];
|
|
|
1336 |
my($dir) = $self->{'project_file_list'}->{$ikey}->[1];
|
| 217 |
bj |
1337 |
my($cfile) = $creator->translate_value('after', $ikey);
|
| 107 |
bj |
1338 |
## Remove our starting directory from the projects directory
|
|
|
1339 |
## to get the right part of the directory to prepend.
|
|
|
1340 |
$dir =~ s/^$cwd[\/\\]*//;
|
|
|
1341 |
|
|
|
1342 |
## Turn the append value into a key for 'project_info' and
|
|
|
1343 |
## prepend the directory to the file.
|
|
|
1344 |
my($ccheck) = $append;
|
|
|
1345 |
$ccheck =~ s/"//g;
|
|
|
1346 |
if ($dir ne '') {
|
|
|
1347 |
$dir .= '/';
|
|
|
1348 |
$ccheck = "$dir$ccheck";
|
|
|
1349 |
$file = "$dir$file";
|
|
|
1350 |
}
|
|
|
1351 |
|
|
|
1352 |
## If the append value key contains a reference to the project
|
|
|
1353 |
## that we were going to append the dependency value, then
|
|
|
1354 |
## ignore the generated dependency. It is redundant and
|
|
|
1355 |
## quite possibly wrong.
|
|
|
1356 |
if (!defined $self->{'project_info'}->{$ccheck} ||
|
|
|
1357 |
!$self->indirect_depdency($dir, $ccheck, $cfile)) {
|
|
|
1358 |
## Append the dependency
|
|
|
1359 |
$self->{'project_info'}->{$file}->[1] .= " $append";
|
|
|
1360 |
}
|
|
|
1361 |
}
|
|
|
1362 |
}
|
|
|
1363 |
}
|
|
|
1364 |
}
|
|
|
1365 |
|
|
|
1366 |
## Restore the modified values in case this method is called again
|
|
|
1367 |
## which is the case when using the -hierarchy option.
|
|
|
1368 |
foreach my $skey (keys %save) {
|
|
|
1369 |
$self->{'project_file_list'}->{$skey}->[2] = $save{$skey};
|
|
|
1370 |
}
|
|
|
1371 |
}
|
|
|
1372 |
|
|
|
1373 |
|
|
|
1374 |
sub get_projects {
|
|
|
1375 |
my($self) = shift;
|
|
|
1376 |
return $self->{'projects'};
|
|
|
1377 |
}
|
|
|
1378 |
|
|
|
1379 |
|
|
|
1380 |
sub get_project_info {
|
|
|
1381 |
my($self) = shift;
|
|
|
1382 |
return $self->{'project_info'};
|
|
|
1383 |
}
|
|
|
1384 |
|
|
|
1385 |
|
|
|
1386 |
sub get_lib_locations {
|
|
|
1387 |
my($self) = shift;
|
|
|
1388 |
return $self->{'lib_locations'};
|
|
|
1389 |
}
|
|
|
1390 |
|
|
|
1391 |
|
|
|
1392 |
sub get_first_level_directory {
|
|
|
1393 |
my($self) = shift;
|
|
|
1394 |
my($file) = shift;
|
|
|
1395 |
my($dir) = undef;
|
|
|
1396 |
if (($file =~ tr/\///) > 0) {
|
|
|
1397 |
$dir = $file;
|
|
|
1398 |
$dir =~ s/^([^\/]+\/).*/$1/;
|
|
|
1399 |
$dir =~ s/\/+$//;
|
|
|
1400 |
}
|
|
|
1401 |
else {
|
|
|
1402 |
$dir = '.';
|
|
|
1403 |
}
|
|
|
1404 |
return $dir;
|
|
|
1405 |
}
|
|
|
1406 |
|
|
|
1407 |
|
|
|
1408 |
sub sort_within_group {
|
|
|
1409 |
my($self) = shift;
|
|
|
1410 |
my($list) = shift;
|
|
|
1411 |
my($start) = shift;
|
|
|
1412 |
my($end) = shift;
|
|
|
1413 |
my($deps) = undef;
|
|
|
1414 |
my($ccount) = 0;
|
|
|
1415 |
my($cmax) = ($end - $start) + 1;
|
|
|
1416 |
my($previ) = -1;
|
|
|
1417 |
my($prevpjs) = [];
|
|
|
1418 |
my($movepjs) = [];
|
|
|
1419 |
|
|
|
1420 |
## Put the projects in the order specified
|
|
|
1421 |
## by the project dpendencies.
|
|
|
1422 |
for(my $i = $start; $i <= $end; ++$i) {
|
|
|
1423 |
## If our moved project equals our previously moved project then
|
|
|
1424 |
## we count this as a possible circular dependency.
|
|
|
1425 |
if (defined $$movepjs[0] && defined $$prevpjs[0] &&
|
|
|
1426 |
$$movepjs[0] == $$prevpjs[0] && $$movepjs[1] == $$prevpjs[1]) {
|
|
|
1427 |
++$ccount;
|
|
|
1428 |
}
|
|
|
1429 |
else {
|
|
|
1430 |
$ccount = 0;
|
|
|
1431 |
}
|
|
|
1432 |
|
|
|
1433 |
## Detect circular dependencies
|
|
|
1434 |
if ($ccount > $cmax) {
|
|
|
1435 |
my(@prjs) = ();
|
|
|
1436 |
foreach my $mvgr (@$movepjs) {
|
|
|
1437 |
push(@prjs, $$list[$mvgr]);
|
|
|
1438 |
}
|
|
|
1439 |
my($other) = $$movepjs[0] - 1;
|
|
|
1440 |
if ($other < $start || $other == $$movepjs[1] || !defined $$list[$other]) {
|
|
|
1441 |
$other = undef;
|
|
|
1442 |
}
|
|
|
1443 |
$self->warning('Circular dependency detected while processing the ' .
|
|
|
1444 |
($self->{'current_input'} eq '' ?
|
|
|
1445 |
'default' : $self->{'current_input'}) .
|
|
|
1446 |
' workspace. ' .
|
|
|
1447 |
'The following projects are involved: ' .
|
|
|
1448 |
(defined $other ? "$$list[$other], " : '') .
|
|
|
1449 |
join(' and ', @prjs));
|
|
|
1450 |
return;
|
|
|
1451 |
}
|
|
|
1452 |
|
|
|
1453 |
## Keep track of the previous project movement
|
|
|
1454 |
$prevpjs = $movepjs;
|
|
|
1455 |
if ($previ < $i) {
|
|
|
1456 |
$movepjs = [];
|
|
|
1457 |
}
|
|
|
1458 |
$previ = $i;
|
|
|
1459 |
|
|
|
1460 |
$deps = $self->get_validated_ordering($$list[$i]);
|
| 217 |
bj |
1461 |
if (defined $$deps[0]) {
|
|
|
1462 |
my($baseproj) = $self->mpc_basename($$list[$i]);
|
| 107 |
bj |
1463 |
my($moved) = 0;
|
| 217 |
bj |
1464 |
foreach my $dep (@$deps) {
|
| 107 |
bj |
1465 |
if ($baseproj ne $dep) {
|
|
|
1466 |
## See if the dependency is listed after this project
|
|
|
1467 |
for(my $j = $i + 1; $j <= $end; ++$j) {
|
| 217 |
bj |
1468 |
if ($self->mpc_basename($$list[$j]) eq $dep) {
|
| 107 |
bj |
1469 |
$movepjs = [$i, $j];
|
|
|
1470 |
## If so, move it in front of the current project.
|
|
|
1471 |
## The original code, which had splices, didn't always
|
|
|
1472 |
## work correctly (especially on AIX for some reason).
|
|
|
1473 |
my($save) = $$list[$j];
|
|
|
1474 |
for(my $k = $j; $k > $i; --$k) {
|
|
|
1475 |
$$list[$k] = $$list[$k - 1];
|
|
|
1476 |
}
|
|
|
1477 |
$$list[$i] = $save;
|
|
|
1478 |
|
|
|
1479 |
## Mark that an entry has been moved
|
|
|
1480 |
$moved = 1;
|
|
|
1481 |
$j--;
|
|
|
1482 |
}
|
|
|
1483 |
}
|
|
|
1484 |
}
|
|
|
1485 |
}
|
|
|
1486 |
if ($moved) {
|
|
|
1487 |
$i--;
|
|
|
1488 |
}
|
|
|
1489 |
}
|
|
|
1490 |
}
|
|
|
1491 |
}
|
|
|
1492 |
|
|
|
1493 |
|
| 217 |
bj |
1494 |
sub build_dependency_chain {
|
|
|
1495 |
my($self) = shift;
|
|
|
1496 |
my($name) = shift;
|
|
|
1497 |
my($len) = shift;
|
|
|
1498 |
my($list) = shift;
|
|
|
1499 |
my($ni) = shift;
|
|
|
1500 |
my($glen) = shift;
|
|
|
1501 |
my($groups) = shift;
|
|
|
1502 |
my($map) = shift;
|
|
|
1503 |
my($gdeps) = shift;
|
|
|
1504 |
my($deps) = $self->get_validated_ordering($name);
|
|
|
1505 |
|
|
|
1506 |
if (defined $$deps[0]) {
|
|
|
1507 |
foreach my $dep (@$deps) {
|
|
|
1508 |
## Find the item in the list that matches our current dependency
|
|
|
1509 |
my($mapped) = $$map{$dep};
|
|
|
1510 |
for(my $i = 0; $i < $len; $i++) {
|
|
|
1511 |
if ($$list[$i] eq $mapped) {
|
|
|
1512 |
|
|
|
1513 |
## Locate the group number to which the dependency belongs
|
|
|
1514 |
for(my $j = 0; $j < $glen; $j++) {
|
|
|
1515 |
if ($i >= $$groups[$j]->[0] && $i <= $$groups[$j]->[1]) {
|
|
|
1516 |
|
|
|
1517 |
if ($j != $ni) {
|
|
|
1518 |
## Add every project in the group to the dependency chain
|
|
|
1519 |
for(my $k = $$groups[$j]->[0]; $k <= $$groups[$j]->[1]; $k++) {
|
|
|
1520 |
my($ldep) = $self->mpc_basename($$list[$k]);
|
|
|
1521 |
if (!exists $$gdeps{$ldep}) {
|
|
|
1522 |
$$gdeps{$ldep} = 1;
|
|
|
1523 |
$self->build_dependency_chain($$list[$k],
|
|
|
1524 |
$len, $list, $j,
|
|
|
1525 |
$glen, $groups,
|
|
|
1526 |
$map, $gdeps);
|
|
|
1527 |
}
|
|
|
1528 |
}
|
|
|
1529 |
}
|
|
|
1530 |
last;
|
|
|
1531 |
}
|
|
|
1532 |
}
|
|
|
1533 |
last;
|
|
|
1534 |
}
|
|
|
1535 |
}
|
|
|
1536 |
|
|
|
1537 |
$$gdeps{$dep} = 1;
|
|
|
1538 |
}
|
|
|
1539 |
}
|
|
|
1540 |
}
|
|
|
1541 |
|
|
|
1542 |
|
| 107 |
bj |
1543 |
sub sort_by_groups {
|
|
|
1544 |
my($self) = shift;
|
|
|
1545 |
my($list) = shift;
|
|
|
1546 |
my($grindex) = shift;
|
|
|
1547 |
my(@groups) = @$grindex;
|
| 217 |
bj |
1548 |
my($llen) = scalar(@$list);
|
| 107 |
bj |
1549 |
|
| 217 |
bj |
1550 |
## Check for duplicates first before we attempt to sort the groups.
|
|
|
1551 |
## If there is a duplicate, we quietly return immediately. The
|
|
|
1552 |
## duplicates will be flagged as an error when creating the main
|
|
|
1553 |
## workspace.
|
|
|
1554 |
my(%dupcheck) = ();
|
|
|
1555 |
foreach my $proj (@$list) {
|
|
|
1556 |
my($base) = $self->mpc_basename($proj);
|
|
|
1557 |
if (defined $dupcheck{$base}) {
|
|
|
1558 |
return;
|
| 107 |
bj |
1559 |
}
|
| 217 |
bj |
1560 |
$dupcheck{$base} = $proj;
|
|
|
1561 |
}
|
| 107 |
bj |
1562 |
|
| 217 |
bj |
1563 |
my(%circular_checked) = ();
|
|
|
1564 |
for(my $gi = 0; $gi <= $#groups; ++$gi) {
|
| 107 |
bj |
1565 |
## Detect circular dependencies
|
| 217 |
bj |
1566 |
if (!$circular_checked{$gi}) {
|
|
|
1567 |
$circular_checked{$gi} = 1;
|
|
|
1568 |
for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
|
|
|
1569 |
my(%gdeps) = ();
|
|
|
1570 |
$self->build_dependency_chain($$list[$i], $llen, $list, $gi,
|
|
|
1571 |
$#groups + 1, \@groups,
|
|
|
1572 |
\%dupcheck, \%gdeps);
|
|
|
1573 |
if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
|
|
|
1574 |
## There was a cirular dependency, get all of the directories
|
|
|
1575 |
## involved.
|
|
|
1576 |
my(%dirs) = ();
|
|
|
1577 |
foreach my $gdep (keys %gdeps) {
|
|
|
1578 |
$dirs{$self->mpc_dirname($dupcheck{$gdep})} = 1;
|
|
|
1579 |
}
|
|
|
1580 |
|
|
|
1581 |
## If the current directory was involved, translate that into
|
|
|
1582 |
## a directory relative to the start directory.
|
|
|
1583 |
if (defined $dirs{'.'}) {
|
|
|
1584 |
my($cwd) = $self->getcwd();
|
|
|
1585 |
my($start) = $self->getstartdir();
|
|
|
1586 |
if ($cwd ne $start) {
|
|
|
1587 |
my($startre) = $self->escape_regex_special($start);
|
|
|
1588 |
delete $dirs{'.'};
|
|
|
1589 |
$cwd =~ s/^$startre[\\\/]//;
|
|
|
1590 |
$dirs{$cwd} = 1;
|
|
|
1591 |
}
|
|
|
1592 |
}
|
|
|
1593 |
|
|
|
1594 |
## Display a warining to the user
|
|
|
1595 |
my(@keys) = sort keys %dirs;
|
|
|
1596 |
$self->warning('Circular directory dependency detected in the ' .
|
|
|
1597 |
($self->{'current_input'} eq '' ?
|
|
|
1598 |
'default' : $self->{'current_input'}) .
|
|
|
1599 |
' workspace. ' .
|
|
|
1600 |
'The following director' .
|
|
|
1601 |
($#keys == 0 ? 'y is' : 'ies are') .
|
|
|
1602 |
' involved: ' . join(', ', @keys));
|
|
|
1603 |
return;
|
|
|
1604 |
}
|
| 107 |
bj |
1605 |
}
|
|
|
1606 |
}
|
|
|
1607 |
|
|
|
1608 |
## Build up the group dependencies
|
|
|
1609 |
my(%gdeps) = ();
|
|
|
1610 |
for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
|
|
|
1611 |
my($deps) = $self->get_validated_ordering($$list[$i]);
|
| 217 |
bj |
1612 |
if (defined $$deps[0]) {
|
|
|
1613 |
@gdeps{@$deps} = ();
|
| 107 |
bj |
1614 |
}
|
|
|
1615 |
}
|
|
|
1616 |
|
|
|
1617 |
## Search the rest of the groups for any of the group dependencies
|
|
|
1618 |
for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) {
|
|
|
1619 |
for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) {
|
| 217 |
bj |
1620 |
if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
|
| 107 |
bj |
1621 |
## Move this group ($gj) in front of the current group ($gi)
|
|
|
1622 |
my(@save) = ();
|
|
|
1623 |
for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) {
|
|
|
1624 |
push(@save, $$list[$j]);
|
|
|
1625 |
}
|
|
|
1626 |
my($offset) = $groups[$gj]->[1] - $groups[$gi]->[1];
|
|
|
1627 |
for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) {
|
|
|
1628 |
$$list[$j + $offset] = $$list[$j];
|
|
|
1629 |
}
|
|
|
1630 |
for(my $j = 0; $j <= $#save; ++$j) {
|
|
|
1631 |
$$list[$groups[$gi]->[0] + $j] = $save[$j];
|
|
|
1632 |
}
|
|
|
1633 |
|
|
|
1634 |
## Update the group indices
|
|
|
1635 |
my($shiftamt) = ($groups[$gi]->[1] - $groups[$gi]->[0]) + 1;
|
|
|
1636 |
for(my $j = $gi + 1; $j <= $gj; ++$j) {
|
|
|
1637 |
$groups[$j]->[0] -= $shiftamt;
|
|
|
1638 |
$groups[$j]->[1] -= $shiftamt;
|
|
|
1639 |
}
|
|
|
1640 |
my(@grsave) = @{$groups[$gi]};
|
|
|
1641 |
$grsave[0] += $offset;
|
|
|
1642 |
$grsave[1] += $offset;
|
|
|
1643 |
for(my $j = $gi; $j < $gj; ++$j) {
|
|
|
1644 |
$groups[$j] = $groups[$j + 1];
|
|
|
1645 |
}
|
|
|
1646 |
$groups[$gj] = \@grsave;
|
|
|
1647 |
|
| 217 |
bj |
1648 |
## Start over from the first group
|
|
|
1649 |
$gi = -1;
|
|
|
1650 |
|
|
|
1651 |
## Exit from the outter ($gj) loop
|
|
|
1652 |
$gj = $#groups;
|
| 107 |
bj |
1653 |
last;
|
|
|
1654 |
}
|
|
|
1655 |
}
|
|
|
1656 |
}
|
|
|
1657 |
}
|
|
|
1658 |
}
|
|
|
1659 |
|
|
|
1660 |
|
|
|
1661 |
sub sort_dependencies {
|
|
|
1662 |
my($self) = shift;
|
|
|
1663 |
my($projects) = shift;
|
| 217 |
bj |
1664 |
my($groups) = shift;
|
| 198 |
bj |
1665 |
my(@list) = sort { return $self->sort_projects_by_directory($a, $b) + 0;
|
|
|
1666 |
} @$projects;
|
| 217 |
bj |
1667 |
## The list above is sorted by directory in order to keep projects
|
|
|
1668 |
## within the same directory together. Otherwise, when groups are
|
|
|
1669 |
## created we may get multiple groups for the same directory.
|
| 107 |
bj |
1670 |
|
|
|
1671 |
## Put the projects in the order specified
|
|
|
1672 |
## by the project dpendencies. We only need to do
|
|
|
1673 |
## this if there is more than one element in the array.
|
|
|
1674 |
if ($#list > 0) {
|
| 217 |
bj |
1675 |
## If the parameter wasn't passed in or it was passed in
|
|
|
1676 |
## and was true, sort with directory groups in mind
|
|
|
1677 |
if (!defined $groups || $groups) {
|
|
|
1678 |
## First determine the individual groups
|
|
|
1679 |
my(@grindex) = ();
|
|
|
1680 |
my($previous) = [0, undef];
|
|
|
1681 |
for(my $li = 0; $li <= $#list; ++$li) {
|
|
|
1682 |
my($dir) = $self->get_first_level_directory($list[$li]);
|
|
|
1683 |
if (!defined $previous->[1]) {
|
|
|
1684 |
$previous = [$li, $dir];
|
|
|
1685 |
}
|
|
|
1686 |
elsif ($previous->[1] ne $dir) {
|
|
|
1687 |
push(@grindex, [$previous->[0], $li - 1]);
|
|
|
1688 |
$previous = [$li, $dir];
|
|
|
1689 |
}
|
| 107 |
bj |
1690 |
}
|
| 217 |
bj |
1691 |
push(@grindex, [$previous->[0], $#list]);
|
|
|
1692 |
|
|
|
1693 |
## Next, sort the individual groups
|
|
|
1694 |
foreach my $gr (@grindex) {
|
|
|
1695 |
if ($$gr[0] != $$gr[1]) {
|
|
|
1696 |
$self->sort_within_group(\@list, @$gr);
|
|
|
1697 |
}
|
| 107 |
bj |
1698 |
}
|
|
|
1699 |
|
| 217 |
bj |
1700 |
## Now sort the groups as single entities
|
|
|
1701 |
if ($#grindex > 0) {
|
|
|
1702 |
$self->sort_by_groups(\@list, \@grindex);
|
| 107 |
bj |
1703 |
}
|
|
|
1704 |
}
|
| 217 |
bj |
1705 |
else {
|
|
|
1706 |
$self->sort_within_group(\@list, 0, $#list);
|
| 107 |
bj |
1707 |
}
|
|
|
1708 |
}
|
|
|
1709 |
|
|
|
1710 |
return @list;
|
|
|
1711 |
}
|
|
|
1712 |
|
|
|
1713 |
|
|
|
1714 |
sub number_target_deps {
|
|
|
1715 |
my($self) = shift;
|
|
|
1716 |
my($projects) = shift;
|
|
|
1717 |
my($pjs) = shift;
|
|
|
1718 |
my($targets) = shift;
|
| 217 |
bj |
1719 |
my($groups) = shift;
|
|
|
1720 |
my(@list) = $self->sort_dependencies($projects, $groups);
|
| 107 |
bj |
1721 |
|
|
|
1722 |
## This block of code must be done after the list of dependencies
|
|
|
1723 |
## has been sorted in order to get the correct project numbers.
|
|
|
1724 |
for(my $i = 0; $i <= $#list; ++$i) {
|
|
|
1725 |
my($project) = $list[$i];
|
|
|
1726 |
if (defined $$pjs{$project}) {
|
|
|
1727 |
my($name, $deps) = @{$$pjs{$project}};
|
|
|
1728 |
if (defined $deps && $deps ne '') {
|
| 217 |
bj |
1729 |
my(@numbers) = ();
|
|
|
1730 |
my(%dhash) = ();
|
|
|
1731 |
@dhash{@{$self->create_array($deps)}} = ();
|
| 107 |
bj |
1732 |
|
|
|
1733 |
## For each dependency, search in the sorted list
|
|
|
1734 |
## up to the point of this project for the projects
|
|
|
1735 |
## that this one depends on. When the project is
|
| 217 |
bj |
1736 |
## found, we put the target number in the numbers array.
|
|
|
1737 |
for(my $j = 0; $j < $i; ++$j) {
|
|
|
1738 |
if (exists $dhash{$self->mpc_basename($list[$j])}) {
|
|
|
1739 |
push(@numbers, $j);
|
| 107 |
bj |
1740 |
}
|
|
|
1741 |
}
|
|
|
1742 |
|
| 217 |
bj |
1743 |
## Store the array in the hash keyed on the project file.
|
| 107 |
bj |
1744 |
if (defined $numbers[0]) {
|
|
|
1745 |
$$targets{$project} = \@numbers;
|
|
|
1746 |
}
|
|
|
1747 |
}
|
|
|
1748 |
}
|
|
|
1749 |
}
|
|
|
1750 |
|
|
|
1751 |
return @list;
|
|
|
1752 |
}
|
|
|
1753 |
|
|
|
1754 |
|
|
|
1755 |
sub project_target_translation {
|
| 198 |
bj |
1756 |
my($self) = shift;
|
|
|
1757 |
my($case) = shift;
|
|
|
1758 |
my(%map) = ();
|
| 107 |
bj |
1759 |
|
|
|
1760 |
## Translate project names to avoid target collision with
|
|
|
1761 |
## some versions of make.
|
|
|
1762 |
foreach my $key (keys %{$self->{'project_info'}}) {
|
|
|
1763 |
my($dir) = $self->mpc_dirname($key);
|
|
|
1764 |
my($name) = $self->{'project_info'}->{$key}->[0];
|
|
|
1765 |
|
| 198 |
bj |
1766 |
## We want to compare to the upper most directory. This will be the
|
|
|
1767 |
## one that may conflict with the project name.
|
|
|
1768 |
$dir =~ s/[\/\\].*//;
|
|
|
1769 |
if (($case && $dir eq $name) || (!$case && lc($dir) eq lc($name))) {
|
| 107 |
bj |
1770 |
$map{$key} = "$name-target";
|
|
|
1771 |
}
|
|
|
1772 |
else {
|
|
|
1773 |
$map{$key} = $name;
|
|
|
1774 |
}
|
|
|
1775 |
}
|
|
|
1776 |
return \%map;
|
|
|
1777 |
}
|
|
|
1778 |
|
|
|
1779 |
|
|
|
1780 |
sub optionError {
|
|
|
1781 |
my($self) = shift;
|
|
|
1782 |
my($str) = shift;
|
|
|
1783 |
$self->warning("$self->{'current_input'}: $str.");
|
|
|
1784 |
}
|
|
|
1785 |
|
|
|
1786 |
|
|
|
1787 |
sub process_cmdline {
|
|
|
1788 |
my($self) = shift;
|
|
|
1789 |
my($cmdline) = shift;
|
|
|
1790 |
my($parameters) = shift;
|
|
|
1791 |
|
|
|
1792 |
## It's ok to use the cache
|
|
|
1793 |
$self->{'cacheok'} = 1;
|
|
|
1794 |
|
|
|
1795 |
if (defined $cmdline && $cmdline ne '') {
|
|
|
1796 |
my($args) = $self->create_array($cmdline);
|
|
|
1797 |
|
|
|
1798 |
## Look for environment variables
|
|
|
1799 |
foreach my $arg (@$args) {
|
|
|
1800 |
while($arg =~ /\$(\w+)/) {
|
|
|
1801 |
my($name) = $1;
|
|
|
1802 |
my($val) = '';
|
|
|
1803 |
if ($name eq 'PWD') {
|
|
|
1804 |
$val = $self->getcwd();
|
|
|
1805 |
}
|
|
|
1806 |
elsif (defined $ENV{$name}) {
|
|
|
1807 |
$val = $ENV{$name};
|
|
|
1808 |
}
|
|
|
1809 |
$arg =~ s/\$\w+/$val/;
|
|
|
1810 |
}
|
|
|
1811 |
}
|
|
|
1812 |
|
|
|
1813 |
my($options) = $self->options('MWC', {}, 0, @$args);
|
|
|
1814 |
if (defined $options) {
|
|
|
1815 |
foreach my $key (keys %$options) {
|
|
|
1816 |
my($type) = $self->is_set($key, $options);
|
|
|
1817 |
|
|
|
1818 |
if (!defined $type) {
|
|
|
1819 |
## This option was not used, so we ignore it
|
|
|
1820 |
}
|
|
|
1821 |
elsif ($type eq 'ARRAY') {
|
|
|
1822 |
push(@{$parameters->{$key}}, @{$options->{$key}});
|
|
|
1823 |
}
|
|
|
1824 |
elsif ($type eq 'HASH') {
|
|
|
1825 |
foreach my $hk (keys %{$options->{$key}}) {
|
|
|
1826 |
$parameters->{$key}->{$hk} = $options->{$key}->{$hk};
|
|
|
1827 |
}
|
|
|
1828 |
}
|
|
|
1829 |
elsif ($type eq 'SCALAR') {
|
|
|
1830 |
$parameters->{$key} = $options->{$key};
|
|
|
1831 |
}
|
|
|
1832 |
}
|
|
|
1833 |
|
|
|
1834 |
## Issue warnings for these options
|
|
|
1835 |
if (defined $options->{'recurse'}) {
|
|
|
1836 |
$self->optionError('-recurse is ignored');
|
|
|
1837 |
}
|
|
|
1838 |
if (defined $options->{'reldefs'}) {
|
|
|
1839 |
$self->optionError('-noreldefs is ignored');
|
|
|
1840 |
}
|
|
|
1841 |
if (defined $options->{'coexistence'}) {
|
|
|
1842 |
$self->optionError('-make_coexistence is ignored');
|
|
|
1843 |
}
|
|
|
1844 |
if (defined $options->{'into'}) {
|
|
|
1845 |
$self->optionError('-into is ignored');
|
|
|
1846 |
}
|
|
|
1847 |
if (defined $options->{'input'}->[0]) {
|
|
|
1848 |
$self->optionError('Command line files ' .
|
|
|
1849 |
'specified in a workspace are ignored');
|
|
|
1850 |
}
|
|
|
1851 |
|
|
|
1852 |
## Determine if it's ok to use the cache
|
|
|
1853 |
my(@cacheInvalidating) = ('global', 'include', 'baseprojs',
|
| 217 |
bj |
1854 |
'template', 'ti', 'relative', 'language',
|
| 107 |
bj |
1855 |
'addtemp', 'addproj', 'feature_file',
|
|
|
1856 |
'features', 'use_env', 'expand_vars');
|
|
|
1857 |
foreach my $key (@cacheInvalidating) {
|
|
|
1858 |
if ($self->is_set($key, $options)) {
|
|
|
1859 |
$self->{'cacheok'} = 0;
|
|
|
1860 |
last;
|
|
|
1861 |
}
|
|
|
1862 |
}
|
|
|
1863 |
}
|
|
|
1864 |
}
|
|
|
1865 |
}
|
|
|
1866 |
|
|
|
1867 |
|
|
|
1868 |
sub current_parameters {
|
|
|
1869 |
my($self) = shift;
|
|
|
1870 |
my(%parameters) = $self->save_state();
|
|
|
1871 |
|
|
|
1872 |
## We always want the project creator to generate a toplevel
|
|
|
1873 |
$parameters{'toplevel'} = 1;
|
|
|
1874 |
return %parameters;
|
|
|
1875 |
}
|
|
|
1876 |
|
|
|
1877 |
|
|
|
1878 |
sub project_creator {
|
|
|
1879 |
my($self) = shift;
|
|
|
1880 |
my($str) = "$self";
|
|
|
1881 |
|
|
|
1882 |
## NOTE: If the subclassed WorkspaceCreator name prefix does not
|
|
|
1883 |
## match the name prefix of the ProjectCreator, this code
|
|
|
1884 |
## will not work and the subclassed WorkspaceCreator will
|
|
|
1885 |
## need to override this method.
|
|
|
1886 |
|
|
|
1887 |
$str =~ s/Workspace/Project/;
|
|
|
1888 |
$str =~ s/=HASH.*//;
|
|
|
1889 |
|
|
|
1890 |
## Set up values for each project creator
|
|
|
1891 |
## If we have command line arguments in the workspace, then
|
|
|
1892 |
## we process them before creating the project creator
|
|
|
1893 |
my($cmdline) = $self->get_assignment('cmdline');
|
|
|
1894 |
my(%parameters) = $self->current_parameters();
|
|
|
1895 |
$self->process_cmdline($cmdline, \%parameters);
|
|
|
1896 |
|
|
|
1897 |
## Create the new project creator with the updated parameters
|
|
|
1898 |
return $str->new($parameters{'global'},
|
|
|
1899 |
$parameters{'include'},
|
|
|
1900 |
$parameters{'template'},
|
|
|
1901 |
$parameters{'ti'},
|
|
|
1902 |
$parameters{'dynamic'},
|
|
|
1903 |
$parameters{'static'},
|
|
|
1904 |
$parameters{'relative'},
|
|
|
1905 |
$parameters{'addtemp'},
|
|
|
1906 |
$parameters{'addproj'},
|
|
|
1907 |
$parameters{'progress'},
|
|
|
1908 |
$parameters{'toplevel'},
|
|
|
1909 |
$parameters{'baseprojs'},
|
|
|
1910 |
$self->{'global_feature_file'},
|
|
|
1911 |
$parameters{'feature_file'},
|
|
|
1912 |
$parameters{'features'},
|
|
|
1913 |
$parameters{'hierarchy'},
|
|
|
1914 |
$self->{'exclude'}->{$self->{'wctype'}},
|
|
|
1915 |
$self->make_coexistence(),
|
|
|
1916 |
$parameters{'name_modifier'},
|
|
|
1917 |
$parameters{'apply_project'},
|
| 217 |
bj |
1918 |
$self->{'generate_ins'} || $parameters{'genins'},
|
| 107 |
bj |
1919 |
$parameters{'into'},
|
| 217 |
bj |
1920 |
$parameters{'language'},
|
| 107 |
bj |
1921 |
$parameters{'use_env'},
|
|
|
1922 |
$parameters{'expand_vars'});
|
|
|
1923 |
}
|
|
|
1924 |
|
|
|
1925 |
|
|
|
1926 |
sub sort_files {
|
|
|
1927 |
#my($self) = shift;
|
|
|
1928 |
return 0;
|
|
|
1929 |
}
|
|
|
1930 |
|
|
|
1931 |
|
|
|
1932 |
sub make_coexistence {
|
|
|
1933 |
my($self) = shift;
|
|
|
1934 |
return $self->{'coexistence'};
|
|
|
1935 |
}
|
|
|
1936 |
|
|
|
1937 |
|
|
|
1938 |
sub get_modified_workspace_name {
|
|
|
1939 |
my($self) = shift;
|
|
|
1940 |
my($name) = shift;
|
|
|
1941 |
my($ext) = shift;
|
|
|
1942 |
my($nows) = shift;
|
|
|
1943 |
my($nmod) = $self->get_name_modifier();
|
|
|
1944 |
|
|
|
1945 |
if (defined $nmod) {
|
|
|
1946 |
$nmod =~ s/\*/$name/g;
|
|
|
1947 |
$name = $nmod;
|
|
|
1948 |
}
|
|
|
1949 |
|
|
|
1950 |
## If this is a per project workspace, then we should not
|
|
|
1951 |
## modify the workspace name. It may overwrite another workspace
|
|
|
1952 |
## but that's ok, it will only be a per project workspace.
|
|
|
1953 |
## Also, if we don't want the workspace name attached ($nows) then
|
|
|
1954 |
## we just return the name plus the extension.
|
|
|
1955 |
if ($nows || $self->{'per_project_workspace_name'}) {
|
|
|
1956 |
return "$name$ext";
|
|
|
1957 |
}
|
|
|
1958 |
|
|
|
1959 |
my($pwd) = $self->getcwd();
|
|
|
1960 |
my($type) = $self->{'wctype'};
|
|
|
1961 |
my($wsname) = $self->get_workspace_name();
|
|
|
1962 |
|
|
|
1963 |
if (!defined $previous_workspace_name{$type}->{$pwd}) {
|
|
|
1964 |
$previous_workspace_name{$type}->{$pwd} = $wsname;
|
|
|
1965 |
$self->{'current_workspace_name'} = undef;
|
|
|
1966 |
}
|
|
|
1967 |
else {
|
|
|
1968 |
my($prefix) = ($name eq $wsname ? $name : "$name.$wsname");
|
|
|
1969 |
$previous_workspace_name{$type}->{$pwd} = $wsname;
|
|
|
1970 |
while($self->file_written("$prefix" .
|
|
|
1971 |
($self->{'modified_count'} > 0 ?
|
|
|
1972 |
".$self->{'modified_count'}" : '') .
|
|
|
1973 |
"$ext")) {
|
|
|
1974 |
++$self->{'modified_count'};
|
|
|
1975 |
}
|
|
|
1976 |
$self->{'current_workspace_name'} =
|
|
|
1977 |
"$prefix" . ($self->{'modified_count'} > 0 ?
|
|
|
1978 |
".$self->{'modified_count'}" : '') . "$ext";
|
|
|
1979 |
}
|
|
|
1980 |
|
|
|
1981 |
return (defined $self->{'current_workspace_name'} ?
|
|
|
1982 |
$self->{'current_workspace_name'} : "$name$ext");
|
|
|
1983 |
}
|
|
|
1984 |
|
|
|
1985 |
|
|
|
1986 |
sub generate_recursive_input_list {
|
|
|
1987 |
my($self) = shift;
|
|
|
1988 |
my($dir) = shift;
|
|
|
1989 |
my($exclude) = shift;
|
|
|
1990 |
return $self->extension_recursive_input_list($dir, $exclude, $wsext);
|
|
|
1991 |
}
|
|
|
1992 |
|
|
|
1993 |
|
|
|
1994 |
sub verify_build_ordering {
|
|
|
1995 |
my($self) = shift;
|
|
|
1996 |
foreach my $project (@{$self->{'projects'}}) {
|
|
|
1997 |
$self->get_validated_ordering($project);
|
|
|
1998 |
}
|
|
|
1999 |
}
|
|
|
2000 |
|
|
|
2001 |
|
|
|
2002 |
sub get_validated_ordering {
|
|
|
2003 |
my($self) = shift;
|
|
|
2004 |
my($project) = shift;
|
|
|
2005 |
my($deps) = undef;
|
|
|
2006 |
|
|
|
2007 |
if (defined $self->{'ordering_cache'}->{$project}) {
|
|
|
2008 |
$deps = $self->{'ordering_cache'}->{$project};
|
|
|
2009 |
}
|
|
|
2010 |
else {
|
| 217 |
bj |
2011 |
$deps = [];
|
| 107 |
bj |
2012 |
if (defined $self->{'project_info'}->{$project}) {
|
| 217 |
bj |
2013 |
my($name, $dstr) = @{$self->{'project_info'}->{$project}};
|
|
|
2014 |
if (defined $dstr && $dstr ne '') {
|
|
|
2015 |
$deps = $self->create_array($dstr);
|
|
|
2016 |
my($dlen) = scalar(@$deps);
|
|
|
2017 |
for(my $i = 0; $i < $dlen; $i++) {
|
|
|
2018 |
my($dep) = $$deps[$i];
|
| 107 |
bj |
2019 |
my($found) = 0;
|
|
|
2020 |
## Avoid circular dependencies
|
| 217 |
bj |
2021 |
if ($dep ne $name && $dep ne $self->mpc_basename($project)) {
|
| 107 |
bj |
2022 |
foreach my $p (@{$self->{'projects'}}) {
|
|
|
2023 |
if ($dep eq $self->{'project_info'}->{$p}->[0] ||
|
| 217 |
bj |
2024 |
$dep eq $self->mpc_basename($p)) {
|
| 107 |
bj |
2025 |
$found = 1;
|
|
|
2026 |
last;
|
|
|
2027 |
}
|
|
|
2028 |
}
|
|
|
2029 |
if (!$found) {
|
|
|
2030 |
if (defined $ENV{MPC_VERBOSE_ORDERING}) {
|
|
|
2031 |
$self->warning("'$name' references '$dep' which has " .
|
|
|
2032 |
"not been processed.");
|
|
|
2033 |
}
|
| 217 |
bj |
2034 |
splice(@$deps, $i, 1);
|
|
|
2035 |
--$dlen;
|
|
|
2036 |
--$i;
|
| 107 |
bj |
2037 |
}
|
|
|
2038 |
}
|
| 217 |
bj |
2039 |
else {
|
|
|
2040 |
## If a project references itself, we must remove it
|
|
|
2041 |
## from the list of dependencies.
|
|
|
2042 |
splice(@$deps, $i, 1);
|
|
|
2043 |
--$dlen;
|
|
|
2044 |
--$i;
|
|
|
2045 |
}
|
| 107 |
bj |
2046 |
}
|
|
|
2047 |
}
|
|
|
2048 |
|
|
|
2049 |
$self->{'ordering_cache'}->{$project} = $deps;
|
|
|
2050 |
}
|
|
|
2051 |
}
|
|
|
2052 |
|
|
|
2053 |
return $deps;
|
|
|
2054 |
}
|
|
|
2055 |
|
|
|
2056 |
|
|
|
2057 |
sub source_listing_callback {
|
|
|
2058 |
my($self) = shift;
|
|
|
2059 |
my($project_file) = shift;
|
|
|
2060 |
my($project_name) = shift;
|
|
|
2061 |
my($cwd) = $self->getcwd();
|
|
|
2062 |
$self->{'project_file_list'}->{$project_name} = [ $project_file,
|
| 217 |
bj |
2063 |
$cwd, \@_ ];
|
| 107 |
bj |
2064 |
}
|
|
|
2065 |
|
| 198 |
bj |
2066 |
|
|
|
2067 |
sub sort_projects_by_directory {
|
|
|
2068 |
my($self) = shift;
|
|
|
2069 |
my($left) = shift;
|
|
|
2070 |
my($right) = shift;
|
| 217 |
bj |
2071 |
my($sa) = index($left, '/');
|
|
|
2072 |
my($sb) = index($right, '/');
|
| 198 |
bj |
2073 |
|
| 217 |
bj |
2074 |
if ($sa >= 0 && $sb == -1) {
|
| 198 |
bj |
2075 |
return 1;
|
|
|
2076 |
}
|
| 217 |
bj |
2077 |
elsif ($sb >= 0 && $sa == -1) {
|
| 198 |
bj |
2078 |
return -1;
|
|
|
2079 |
}
|
|
|
2080 |
return $left cmp $right;
|
|
|
2081 |
}
|
|
|
2082 |
|
| 107 |
bj |
2083 |
# ************************************************************
|
|
|
2084 |
# Virtual Methods To Be Overridden
|
|
|
2085 |
# ************************************************************
|
|
|
2086 |
|
|
|
2087 |
sub supports_make_coexistence {
|
|
|
2088 |
#my($self) = shift;
|
|
|
2089 |
return 0;
|
|
|
2090 |
}
|
|
|
2091 |
|
|
|
2092 |
|
|
|
2093 |
sub generate_implicit_project_dependencies {
|
|
|
2094 |
#my($self) = shift;
|
|
|
2095 |
return 0;
|
|
|
2096 |
}
|
|
|
2097 |
|
|
|
2098 |
|
|
|
2099 |
sub workspace_file_name {
|
|
|
2100 |
#my($self) = shift;
|
|
|
2101 |
return '';
|
|
|
2102 |
}
|
|
|
2103 |
|
|
|
2104 |
|
|
|
2105 |
sub workspace_per_project {
|
|
|
2106 |
#my($self) = shift;
|
|
|
2107 |
return 0;
|
|
|
2108 |
}
|
|
|
2109 |
|
|
|
2110 |
|
|
|
2111 |
sub pre_workspace {
|
|
|
2112 |
#my($self) = shift;
|
|
|
2113 |
#my($fh) = shift;
|
|
|
2114 |
}
|
|
|
2115 |
|
|
|
2116 |
|
|
|
2117 |
sub write_comps {
|
|
|
2118 |
#my($self) = shift;
|
|
|
2119 |
#my($fh) = shift;
|
|
|
2120 |
#my($gens) = shift;
|
|
|
2121 |
#my($top) = shift;
|
|
|
2122 |
}
|
|
|
2123 |
|
|
|
2124 |
|
|
|
2125 |
sub post_workspace {
|
|
|
2126 |
#my($self) = shift;
|
|
|
2127 |
#my($fh) = shift;
|
|
|
2128 |
}
|
|
|
2129 |
|
|
|
2130 |
|
|
|
2131 |
1;
|