File indexing completed on 2024-04-06 12:31:48
0001 package SCRAMGenUtils;
0002 use File::Basename;
0003 use Storable ;
0004
0005 our $SCRAM_CMD="scram";
0006 our $SCRAM_VERSION="";
0007 local $SCRAM_ARCH="";
0008 local $DEBUG=0;
0009 local $InternalCache={};
0010 local $Cache={};
0011 local $CacheType=1;
0012
0013 sub init ()
0014 {
0015 my $dir=shift;
0016 $CacheType=1;
0017 &scramVersion ($dir);
0018 &getScramArch();
0019 unshift @INC,"$ENV{SCRAM_HOME}/src";
0020 unshift @INC,"${dir}/config";
0021 }
0022
0023 sub fixPath ()
0024 {
0025 my $dir=shift;
0026 my @parts=();
0027 my $p="/";
0028 if($dir!~/^\//){$p="";}
0029 foreach my $part (split /\//, $dir)
0030 {
0031 if($part eq ".."){pop @parts;}
0032 elsif(($part ne "") && ($part ne ".")){push @parts, $part;}
0033 }
0034 return "$p".join("/",@parts);
0035 }
0036
0037 sub findActualPath ()
0038 {
0039 my $file=shift;
0040 if(-l $file)
0041 {
0042 my $dir=dirname($file);
0043 $file=readlink($file);
0044 if($file!~/^\//){$file="${dir}/${file}";}
0045 return &findActualPath($file);
0046 }
0047 return $file;
0048 }
0049
0050 sub readDir ()
0051 {
0052 my $dir=shift;
0053 my $type=shift || 0;
0054 my @data=();
0055 opendir(DIR,$dir) || die "Can not open directory $dir for reading.";
0056 foreach my $f (readdir(DIR))
0057 {
0058 if($f=~/^\./){next;}
0059 if($type == 0){push @data,$f;}
0060 elsif(($type == 1) && (-d "${dir}/${f}")){push @data,$f;}
0061 elsif(($type == 2) && (-f "${dir}/${f}")){push @data,$f;}
0062 }
0063 closedir(DIR);
0064 return @data;
0065 }
0066
0067 sub getTmpFile ()
0068 {
0069 my $dir=shift || &getTmpDir ();
0070 my $index=0;
0071 my $tmp="${dir}/f${index}.$$";
0072 while(-f $tmp)
0073 {$index++;$tmp="${dir}/f${index}.$$";}
0074 system("touch $tmp");
0075 return $tmp;
0076 }
0077
0078 sub getTmpDir ()
0079 {
0080 my $dir=shift;
0081 if(!defined $dir)
0082 {
0083 if((exists $ENV{GEN_UTILS_TMPDIR}) && (-d $ENV{GEN_UTILS_TMPDIR}))
0084 {$dir="$ENV{GEN_UTILS_TMPDIR}";}
0085 else{$dir="/tmp";}
0086 $dir="${dir}/delete_me_$$";
0087 }
0088 my $index=0;
0089 my $tmp="${dir}_${index}";
0090 while(-d $tmp)
0091 {$index++;$tmp="${dir}_d${index}";}
0092 system("mkdir -p $tmp");
0093 return $tmp;
0094 }
0095
0096 sub updateConfigFileData ()
0097 {
0098 my $file=shift;
0099 if (($file eq "") || (!-f "$file")){return "";}
0100 my $data=shift || return $file;
0101 my $cache=shift || {};
0102 my $r;
0103 open ($r,$file) || die "Can not open file for reading:$file\n";
0104 while(my $line=<$r>)
0105 {
0106 chomp $line;
0107 if(($line=~/^\s*
0108 my @x=split /:/,$line;
0109 my $count=scalar(@x);
0110 for(my $i=1;$i<$count;$i++)
0111 {
0112 my $y=$x[$i];
0113 if ($y=~/^\s*$/)
0114 {
0115 for(my $j=$i;$j<$count-1;$j++){$x[$j]=$x[$j+1];}
0116 pop @x;
0117 $count--;
0118 $i--;
0119 next;
0120 }
0121 my $py=$x[$i-1];
0122 if ($py=~/\\$/){$x[$i-1]="$py:$y";$x[$i]="";$i--;}
0123 }
0124 my $c=undef;
0125 my $remove="";
0126 if($x[0]=~/^(X|)DATA$/){$c=$data;$remove=$1;}
0127 elsif($x[0]=~/^(X|)CACHE$/){$c=$cache;$remove=$1;}
0128 if ($remove){$count++;}
0129 if($count<3){next;}
0130 if(defined $c)
0131 {
0132
0133 my $i=0;
0134 for($i=1;$i<$count-2;$i++)
0135 {
0136 my $y=$x[$i];
0137 if(!exists $c->{$y}){$c->{$y}={};}
0138 $c=$c->{$y};
0139 }
0140 if ($remove){delete $c->{$x[$i]};}
0141 else{$c->{$x[$i]}=$x[$i+1];}
0142 }
0143 }
0144 close($r);
0145 return $file;
0146 }
0147
0148 sub findUniqDirs ()
0149 {
0150 my $dirs=shift;
0151 my $dir=shift;
0152 my $uniq = shift || [];
0153 my $c=0;
0154 foreach my $d (keys %$dirs){&findUniqDirs($dirs->{$d},"${dir}/${d}",$uniq);$c++;}
0155 if ($c == 0){push @$uniq,$dir;}
0156 return $uniq;
0157 }
0158
0159
0160
0161
0162
0163 sub scramVersion ()
0164 {
0165 my $rel=shift;
0166 if ($SCRAM_VERSION eq "")
0167 {
0168 if (exists $ENV{SCRAM_HOME}){$SCRAM_VERSION=basename($ENV{SCRAM_HOME}); return $SCRAM_VERSION;}
0169 my $scram=`which $SCRAM_CMD 2>&1`; chomp $scram;
0170 if ($scram!~/\/$SCRAM_CMD\s*$/){die "can not find $SCRAM_CMD command.\n";}
0171 my $dir=`cd $rel; sh -v $scram --help 2>&1 | grep SCRAMV1_ROOT=`; chomp $dir;
0172 $dir=~s/SCRAMV1_ROOT=["']//; $dir=~s/['"].*//;
0173 if (!-d $dir){die "Can not find scram installation path.\n";}
0174 my $sver=basename($dir);
0175 my $sdir=dirname($dir);
0176 $sver=~s/^(V\d+_\d+_).+$/$1/;
0177 my $dref;
0178 if (opendir($dref,$sdir))
0179 {
0180 my %vers=();
0181 foreach my $ver (readdir($dref)){if($ver=~/^$sver/){push @vers,$ver;}}
0182 closedir($dref);
0183 my $c=scalar(@vers);
0184 if($c)
0185 {
0186 @vers=sort @vers;
0187 $dir="${sdir}/".$vers[$c-1];
0188 }
0189 }
0190 $SCRAM_VERSION=basename($dir);
0191 $ENV{SCRAM_HOME}=$dir;
0192 }
0193 return $SCRAM_VERSION;
0194 }
0195
0196 sub fixCacheFileName ()
0197 {
0198 my $file=shift;
0199 my $gz="";
0200 if ($SCRAM_VERSION=~/^V[2-9]/){if($file!~/\.gz$/){$gz=".gz";}}
0201 return "$file$gz";
0202 }
0203
0204 sub readCache()
0205 {
0206 eval ("use Cache::CacheUtilities");
0207 if(!$@){return &Cache::CacheUtilities::read(shift);}
0208 else{die "Unable to find Cache/CacheUtilities.pm PERL module.";}
0209 }
0210
0211 sub writeCache()
0212 {
0213 eval ("use Cache::CacheUtilities");
0214 if(!$@){return &Cache::CacheUtilities::write(shift,shift);}
0215 else{die "Unable to find Cache/CacheUtilities.pm PERL module.";}
0216 }
0217
0218 sub getScramArch ()
0219 {
0220 if($SCRAM_ARCH eq "")
0221 {
0222 if(exists $ENV{SCRAM_ARCH}){$SCRAM_ARCH=$ENV{SCRAM_ARCH};}
0223 else{$SCRAM_ARCH=`$SCRAM_CMD arch`;chomp $SCRAM_ARCH;$ENV{SCRAM_ARCH}=$SCRAM_ARCH;}
0224 }
0225 return $SCRAM_ARCH;
0226 }
0227
0228 sub getFromEnvironmentFile ()
0229 {
0230 my $var=shift;
0231 my $rel=shift;
0232 if(!exists $InternalCache->{$rel}{EnvironmentFile}){&getEnvironmentFileCache($rel);}
0233 if(exists $InternalCache->{$rel}{EnvironmentFile}{$var}){return $InternalCache->{$rel}{EnvironmentFile}{$var};}
0234 return "";
0235 }
0236
0237 sub getEnvironmentFileCache ()
0238 {
0239 my $rel=shift;
0240 if(!exists $InternalCache->{$rel}{EnvironmentFile})
0241 {
0242 my $ref;
0243 $InternalCache->{$rel}{EnvironmentFile}={};
0244 my $arch=&getScramArch();
0245 foreach my $f ("Environment","${arch}/Environment")
0246 {
0247 if (-f "${rel}/.SCRAM/${f}")
0248 {
0249 open($ref,"${rel}/.SCRAM/${f}") || die "Can not open ${rel}/.SCRAM/${f} file for reading.";
0250 while(my $line=<$ref>)
0251 {
0252 if(($line=~/^\s*$/) || ($line=~/^\s*
0253 if($line=~/^\s*([^=\s]+?)\s*=\s*(.+)$/)
0254 {$InternalCache->{$rel}{EnvironmentFile}{$1}=$2;}
0255 }
0256 close($ref);
0257 $InternalCache->{dirty}=1;
0258 }
0259 }
0260 }
0261 return $InternalCache->{$rel}{EnvironmentFile};
0262 }
0263
0264 sub createTmpReleaseArea ()
0265 {
0266 my $rel=shift;
0267 my $dev=shift;
0268 my $dir=shift || &getTmpDir ();
0269 system("mkdir -p $dir");
0270 if($SCRAM_ARCH eq ""){&getScramArch ();}
0271 my $cf=&fixCacheFileName("${rel}/.SCRAM/${SCRAM_ARCH}/ProjectCache.db");
0272 if(!-f $cf){system("cd $rel; $SCRAM_CMD b -r echo_CXX ufast 2>&1 >/dev/null");}
0273 foreach my $sdir (".SCRAM", "config")
0274 {
0275 if(-d "${dir}/${sdir}"){system("rm -rf ${dir}/${sdir}");}
0276 system("cp -rpf ${rel}/${sdir} $dir");
0277 }
0278 my $prn="projectrename";
0279 if ($SCRAM_VERSION=~/^V1_0_/){$prn="ProjectRename";}
0280 system("cd $dir; $SCRAM_CMD build -r $prn >/dev/null 2>&1");
0281 my $setup=0;
0282 my $envfile="${dir}/.SCRAM/${SCRAM_ARCH}/Environment";
0283 if ($SCRAM_VERSION=~/^V1/){$envfile="${dir}/.SCRAM/Environment";}
0284 if($dev)
0285 {
0286 my $rtop=&getFromEnvironmentFile("RELEASETOP",$rel);
0287 if($rtop eq "")
0288 {
0289 system("touch $envfile; echo \"RELEASETOP=$rel\" >> $envfile");
0290 $setup=1;
0291 }
0292 }
0293 else
0294 {
0295 system("chmod -R u+w $dir");
0296 if ($SCRAM_VERSION=~/^V1_/)
0297 {
0298 system("grep -v \"RELEASETOP=\" $envfile > ${envfile}.new");
0299 system("mv ${envfile}.new $envfile");
0300 }
0301 else{system("rm -f $envfile");}
0302 $setup=1;
0303 }
0304 if($setup){system("cd $dir; $SCRAM_CMD setup self >/dev/null 2>&1");}
0305 return $dir;
0306 }
0307
0308 sub getBuildVariable ()
0309 {
0310 my $dir=shift;
0311 my $var=shift || return "";
0312 my $xrule="";
0313 if($SCRAM_VERSION=~/^V[1-9]\d*_[1-9]\d*_/){$xrule=shift;}
0314 my $val=`cd $dir; $SCRAM_CMD b -f echo_${var} $xrule 2>&1 | grep "$var *="`; chomp $val;
0315 $val=~s/^\s*$var\s+=\s+//;
0316 return $val;
0317 }
0318
0319 sub getOrderedTools ()
0320 {
0321 my $cache=shift;
0322 my $rev=shift || 0;
0323 my $tools=$cache->{SETUP};
0324 my $c={};
0325 $c->{done}={};
0326 $c->{scram}={};
0327 $c->{data}=[];
0328 $c->{cache}=$tools;
0329 foreach my $t (sort keys %$tools)
0330 {
0331 if ($t eq "self"){next;}
0332 if ((exists $tools->{$t}{SCRAM_PROJECT}) && ($tools->{$t}{SCRAM_PROJECT}==1)){$c->{scram}{$t}=1;next;}
0333 &_getOrderedTools($c,$t);
0334 }
0335 foreach my $t (keys %{$c->{scram}}){&_getOrderedSTools($c,$t);}
0336 my @odata=();
0337 foreach my $d (@{$c->{data}})
0338 {if (ref($d) eq "ARRAY"){foreach my $t (@$d) {push @odata,$t;}}}
0339 if (exists $tools->{self}){push @odata,$tools->{self};}
0340 my @otools =();
0341 my @ctools=();
0342 foreach my $t ( reverse @odata )
0343 {
0344 if ((exists $t->{SCRAM_COMPILER}) && ($t->{SCRAM_COMPILER}==1)){push @ctools,$t->{TOOLNAME}; next;}
0345 push @otools,$t->{TOOLNAME};
0346 }
0347 push @otools,@ctools;
0348 if ($rev){@otools=reverse @otools;}
0349 return @otools;
0350 }
0351
0352 sub _getOrderedSTools ()
0353 {
0354 my $c=shift;
0355 my $tool=shift;
0356 my $order=-1;
0357 if(exists $c->{done}{$tool}){return $c->{done}{$tool};}
0358 $c->{done}{$tool}=$order;
0359 if(!exists $c->{scram}{$tool}){return $order;}
0360 if(!exists $c->{cache}{$tool}){return $order;}
0361 my $base=uc($tool)."_BASE";
0362 if(!exists $c->{cache}{$tool}{$base}){return $order;}
0363 $base=$c->{cache}{$tool}{$base};
0364 if(!-d $base){print STDERR "ERROR: Release area \"$base\" for \"$tool\" is not available.\n"; return $order;}
0365 my $cfile=&fixCacheFileName("${base}/.SCRAM/${SCRAM_ARCH}/ToolCache.db");
0366 if (!-f $cfile){print STDERR "ERROR: Tools cache file for release area \"$base\" is not available.\n";return $order;}
0367 my $cache=&readCache($cfile);
0368 my $tools=$cache->{SETUP};
0369 my $order=scalar(@{$c->{data}})-1;
0370 foreach my $t (keys %$tools)
0371 {
0372 if($t eq "self"){next;}
0373 if((exists $tools->{$t}{SCRAM_PROJECT}) && ($tools->{$t}{SCRAM_PROJECT}==1))
0374 {
0375 my $o=&_getOrderedSTools($c,$t);
0376 if ($o>$order){$order=$o;}
0377 }
0378 }
0379 $order++;
0380 $c->{done}{$tool}=$order;
0381 if(!defined $c->{data}[$order]){$c->{data}[$order]=[];}
0382 push @{$c->{data}[$order]},$c->{cache}{$tool};
0383 $c->{done}{$tool}=$order;
0384 return $order;
0385 }
0386
0387 sub _getOrderedTools()
0388 {
0389 my $c = shift;
0390 my $tool = shift;
0391 my $order=-1;
0392 if(exists $c->{done}{$tool}){return $c->{done}{$tool};}
0393 $c->{done}{$tool}=$order;
0394 if (exists $c->{cache}{$tool})
0395 {
0396 if (exists $c->{cache}{$tool}{USE})
0397 {
0398 foreach my $use (@{$c->{cache}{$tool}{USE}})
0399 {
0400 my $o=&_getOrderedTools($c,lc($use));
0401 if ($o>$order){$order=$o;}
0402 }
0403 }
0404 $order++;
0405 if(!defined $c->{data}[$order]){$c->{data}[$order]=[];}
0406 push @{$c->{data}[$order]},$c->{cache}{$tool};
0407 $c->{done}{$tool}=$order;
0408 }
0409 return $order;
0410 }
0411
0412
0413
0414
0415 sub writeHashCache ()
0416 {
0417 my $cache=shift;
0418 my $file=shift;
0419 my $binary=shift || undef;
0420 if (!defined $binary){$binary=$CacheType;}
0421 if ($binary)
0422 {
0423 eval {nstore($cache,$file);};
0424 die "Cache write error: ",$EVAL_ERROR,"\n", if ($EVAL_ERROR);
0425 }
0426 else
0427 {
0428 use Data::Dumper;
0429 my $cachefh;
0430 if (open($cachefh,">$file"))
0431 {
0432 $Data::Dumper::Varname='cache';
0433 $Data::Dumper::Purity = 1;
0434 print $cachefh Dumper($cache);
0435 close $cachefh;
0436 }
0437 else{die "can not open file $file for writing.";}
0438 }
0439 }
0440
0441 sub readHashCache ()
0442 {
0443 my $file=shift;
0444 my $binary=shift || undef;
0445 if (!defined $binary){$binary=$CacheType;}
0446 my $cache=undef;
0447 if ($binary)
0448 {
0449 $cache = eval "retrieve(\"$file\")";
0450 die "Cache load error: ",$@,"\n", if ($@);
0451 }
0452 else
0453 {
0454 my $cachefh;
0455 if (open($cachefh,$file))
0456 {
0457 my @cacheitems = <$cachefh>;
0458 close $cachefh;
0459 $cache = eval "@cacheitems";
0460 die "Cache load error: ",$EVAL_ERROR,"\n", if ($EVAL_ERROR);
0461 }
0462 else{die "can not open file $file for reading.";}
0463 }
0464 return $cache;
0465 }
0466
0467
0468
0469
0470 sub scramReleaseTop()
0471 {return &checkWhileSubdirFound(shift,".SCRAM");}
0472
0473 sub checkWhileSubdirFound()
0474 {
0475 my $dir=shift;
0476 my $subdir=shift;
0477 while((!-d "${dir}/${subdir}") && ($dir!~/^[\.\/]$/)){$dir=dirname($dir);}
0478 if(-d "${dir}/${subdir}"){return $dir;}
0479 return "";
0480 }
0481
0482
0483
0484
0485 sub getLibSymbols ()
0486 {
0487 my $file=&findActualPath(shift);
0488 my $filter=shift || ".+";
0489 my $cache={};
0490 if(($file ne "") && (-f $file))
0491 {
0492 foreach my $line (`nm -D $file`)
0493 {
0494 chomp $line;
0495 if($line=~/^([0-9A-Fa-f]+|)\s+([A-Za-z])\s+([^\s]+)\s*$/)
0496 {
0497 my $s=$3; my $type=$2;
0498 if ($type=~/$filter/){$cache->{$s}=$type;}
0499 }
0500 }
0501 }
0502 return $cache;
0503 }
0504
0505 sub getObjectSymbols ()
0506 {
0507 my $file=&findActualPath(shift);
0508 my $filter=shift || ".+";
0509 my $cache={};
0510 if(($file ne "") && (-f $file))
0511 {
0512 foreach my $line (`nm $file`)
0513 {
0514 chomp $line;
0515 if($line=~/^([0-9A-Fa-f]+|)\s+([A-Za-z])\s+([^\s]+)\s*$/)
0516 {
0517 my $s=$3; my $type=$2;
0518 if ($type=~/$filter/){$cache->{$s}=$type;}
0519 }
0520 }
0521 }
0522 return $cache;
0523 }
0524
0525
0526
0527
0528
0529
0530
0531 sub XML2DATA ()
0532 {
0533 my $xml=shift;
0534 my $data=shift || {};
0535 foreach my $c (@{$xml->{child}})
0536 {
0537 if(exists $c->{name})
0538 {
0539 my $n=$c->{name};
0540 if($n=~/^(environment)$/){&XML2DATA($c,$data);}
0541 elsif($n=~/^(library|bin)$/)
0542 {
0543 my $fl=$c->{attrib}{file};
0544 my $p=$c->{attrib}{name};
0545 if($p ne ""){$data->{$n}{$p}{file}=[];}
0546 foreach my $f (split /\s+/,$fl)
0547 {
0548 if($p eq "")
0549 {
0550 $p=basename($f); $p=~s/\.[^.]+$//;
0551 $data->{$n}{$p}{file}=[];
0552 }
0553 push @{$data->{$n}{$p}{file}},"$f";
0554 }
0555 if ($p ne "")
0556 {
0557 $data->{$n}{$p}{deps}={};
0558 &XML2DATA($c,$data->{$n}{$p}{deps});
0559 }
0560 }
0561 elsif($n=~/^(use|lib)$/){$data->{$n}{$c->{attrib}{name}}=1;}
0562 elsif($n=~/^(flags)$/)
0563 {
0564 my @fs=keys %{$c->{attrib}};
0565 my $f=uc($fs[0]);
0566 my $v=$c->{attrib}{$fs[0]};
0567 if(!exists $data->{$n}{$f}){$data->{$n}{$f}=[];}
0568 my $i=scalar(@{$data->{$n}{$f}});
0569 $data->{$n}{$f}[$i]{v}=$v;
0570 }
0571 elsif($n=~/^(architecture)$/)
0572 {
0573 my $a=$c->{attrib}{name};
0574 if(!exists $data->{arch}{$a}){$data->{arch}{$a}={};}
0575 &XML2DATA($c,$data->{arch}{$a});
0576 }
0577 elsif($n=~/^(export)$/)
0578 {
0579 $data->{$n}={};
0580 &XML2DATA($c,$data->{$n});
0581 }
0582 elsif($n=~/^(include_path)$/)
0583 {
0584 $data->{$n}{$c->{attrib}{path}}=1;
0585 }
0586 elsif($n=~/^(makefile)$/)
0587 {
0588 if(!exists $data->{$n}){$data->{$n}=[];}
0589 foreach my $d (@{$c->{cdata}}){push @{$data->{$n}},"$d\n";}
0590 }
0591 }
0592 }
0593 return $data;
0594 }
0595
0596 sub readBuildFile ()
0597 {
0598 my $bfile=shift;
0599 my $raw=shift || 0;
0600 my $bfn=basename($bfile);
0601 eval ("use SCRAM::Plugins::DocParser");
0602 if($@){die "Can not locate SCRAM/Plugins/DocParser.pm perl module for reading $bfile.\n";}
0603 my $input=undef;
0604 if ($bfn!~/BuildFile\.xml(.auto|)/)
0605 {
0606 eval ("use SCRAM::Plugins::Doc2XML");
0607 if($@){die "Can not locate SCRAM/Plugins/Doc2XML.pm perl module for reading $bfile.\n";}
0608 my $doc2xml = SCRAM::Plugins::Doc2XML->new(0);
0609 my $xml=$doc2xml->convert($bfile);
0610 $input = join("",@$xml);
0611 }
0612 else
0613 {
0614 my $ref;
0615 if(open($ref,$bfile))
0616 {
0617 while(my $l=<$ref>)
0618 {
0619 chomp $l;
0620 if ($l=~/^\s*(
0621 $input.="$l ";
0622 }
0623 }
0624 }
0625 my $xml = SCRAM::Plugins::DocParser->new();
0626 $xml->parse($bfile,$input);
0627 if ($raw){return $xml->{output};}
0628 return &XML2DATA($xml->{output});
0629 }
0630
0631 sub convert2XMLBuildFile ()
0632 {
0633 &dumpXMLBuildFile(&readBuildFile(shift,1),shift);
0634 }
0635
0636 sub findBuildFileTag ()
0637 {
0638 my $data=shift;
0639 my $bf=shift;
0640 my $tag=shift;
0641 my $d=shift || {};
0642 my $arch=shift || "FORALLARCH";
0643 my $pt=$data->{prodtype};
0644 my $pn=$data->{prodname};
0645 if(exists $bf->{$tag})
0646 {
0647 if(!exists $d->{$arch}){$d->{$arch}=[];}
0648 push @{$d->{$arch}},$bf;
0649 }
0650 if($pt && (exists $bf->{$pt}) && (exists $bf->{$pt}{$pn}) && (exists $bf->{$pt}{$pn}{deps}))
0651 {&findBuildFileTag($data,$bf->{$pt}{$pn}{deps},$tag,$d,$arch);}
0652 if(exists $bf->{arch})
0653 {
0654 if($SCRAM_ARCH eq ""){&getScramArch ();}
0655 foreach my $arch (keys %{$bf->{arch}})
0656 {if($SCRAM_ARCH=~/$arch/){&findBuildFileTag($data,$bf->{arch}{$arch},$tag,$d,$arch);}}
0657 }
0658 return $d;
0659 }
0660
0661 sub updateFromRefBuildFile ()
0662 {
0663 my $cacherefbf = shift;
0664 my $data = shift;
0665 if(defined $cacherefbf)
0666 {
0667 my $f=&findBuildFileTag($data,$cacherefbf,"flags");
0668 my $l=&findBuildFileTag($data,$cacherefbf,"lib");
0669 my $m=&findBuildFileTag($data,$cacherefbf,"makefile");
0670 my $i=&findBuildFileTag($data,$cacherefbf,"include_path");
0671 my $ix={};
0672 if(exists $cacherefbf->{export})
0673 {$ix=&findBuildFileTag($data,$cacherefbf->{export},"include_path");}
0674 foreach my $a (keys %$f)
0675 {
0676 foreach my $c (@{$f->{$a}})
0677 {
0678 foreach my $f1 (keys %{$c->{flags}})
0679 {
0680 if(($f1 eq "SEAL_PLUGIN_NAME") || ($f1 eq "SEALPLUGIN") || ($f1 eq "EDM_PLUGIN")){next;}
0681 foreach my $fv (@{$c->{flags}{$f1}}){push @{$data->{bfflags}},"$f1=".$fv->{v};}
0682 }
0683 }
0684 }
0685 foreach my $a (keys %$l)
0686 {
0687 foreach my $c (@{$l->{$a}})
0688 {foreach my $f1 (keys %{$c->{lib}}){$data->{lib}{$a}{$f1}=1;}}
0689 }
0690 foreach my $a (keys %$i)
0691 {
0692 foreach my $c (@{$i->{$a}})
0693 {foreach my $f1 (keys %{$c->{include_path}}){$data->{include_path}{$a}{$f1}=1;}}
0694 }
0695 foreach my $a (keys %$ix)
0696 {
0697 foreach my $c (@{$ix->{$a}})
0698 {foreach my $f1 (keys %{$c->{include_path}}){$data->{export}{include_path}{$a}{$f1}=1;}}
0699 }
0700 foreach my $a (keys %$m)
0701 {
0702 foreach my $c (@{$m->{$a}})
0703 {
0704 my $c1=$c->{makefile};
0705 if(scalar(@$c1)>0)
0706 {
0707 if(!exists $data->{makefile}{$a}){$data->{makefile}{$a}=[];}
0708 foreach my $f1 (@$c1){push @{$data->{makefile}{$a}},$f1;}
0709 }
0710 }
0711 }
0712 }
0713 }
0714
0715 sub _xmlendtag()
0716 {
0717 my $xml=shift;
0718 if($xml){return "/";}
0719 return "";
0720 }
0721
0722 sub dumpXMLBuildFile ()
0723 {
0724 my $xml=shift;
0725 my $outfile=shift;
0726 my $tab=shift || "";
0727 my $ref=undef;
0728 if (!ref($outfile)){open($ref,">$outfile") || die "CAn not open file for writing:$outfile\n";}
0729 else{$ref=$outfile;}
0730 foreach my $c (@{$xml->{child}})
0731 {
0732 if(exists $c->{name})
0733 {
0734 my $n=$c->{name};
0735 if($n=~/^(environment)$/){print $ref "${tab}<$n>\n";&dumpXMLBuildFile($c,$ref,"$tab ");print $ref "${tab}</$n>\n";}
0736 elsif($n=~/^(library|bin)$/)
0737 {
0738 my $fl=$c->{attrib}{file};
0739 my $p=$c->{attrib}{name};
0740 my @fs=();
0741 foreach my $f (split /\s+/,$fl)
0742 {
0743 if($p eq ""){$p=basename($f); $p=~s/\.[^.]+$//;}
0744 push @fs,$f;
0745 }
0746 if ($p ne "")
0747 {
0748 print $ref "${tab}<$n name=\"$p\" file=\"",join(",",@fs),"\">\n";
0749 &dumpXMLBuildFile($c,$ref,"$tab ");
0750 print $ref "${tab}</$n>\n";
0751 }
0752 }
0753 elsif($n=~/^(use|lib)$/){print $ref "${tab}<$n name=\"",$c->{attrib}{name},"\"/>\n";}
0754 elsif($n=~/^(flags)$/)
0755 {
0756 my @fs=keys %{$c->{attrib}};
0757 my $f=uc($fs[0]);
0758 my $v=$c->{attrib}{$fs[0]};
0759 print $ref "${tab}<$n $f=\"$v\"/>\n";
0760 }
0761 elsif($n=~/^(architecture)$/)
0762 {
0763 my $a=$c->{attrib}{name};
0764 print $ref "${tab}<$n name=\"",$c->{attrib}{name},"\">\n";
0765 &dumpXMLBuildFile($c,$ref,"$tab ");
0766 print $ref "${tab}</$n>\n";
0767 }
0768 elsif($n=~/^(export)$/)
0769 {
0770 print $ref "${tab}<$n>\n";
0771 &dumpXMLBuildFile($c,$ref,"$tab ");
0772 print $ref "${tab}</$n>\n";
0773 }
0774 elsif($n=~/^(include_path)$/)
0775 {
0776 print $ref "${tab}<$n path=\"",$c->{attrib}{path},"\"/>\n";
0777 }
0778 elsif($n=~/^(makefile)$/)
0779 {
0780 print $ref "${tab}<$n>\n";
0781 if(!exists $data->{$n}){$data->{$n}=[];}
0782 foreach my $d (@{$c->{cdata}}){print $ref "$d\n";}
0783 print $ref "${tab}</$n>\n";
0784 }
0785 }
0786 }
0787 if (!ref($outfile)){close($ref);}
0788 }
0789
0790 sub printBuildFile ()
0791 {
0792 my $data=shift;
0793 my $file=shift;
0794 my $tab="";
0795 my $isPackage=$data->{isPackage};
0796 my $prodtype=$data->{prodtype};
0797 my $prodname=$data->{prodname};
0798 my $filestr=$data->{filestr};
0799 my $ccfiles=$data->{ccfiles};
0800 my $outfile=STDOUT;
0801 my $closefile=0;
0802 my $bfn=basename($file);
0803 my $xml=0;
0804 if($bfn=~/BuildFile\.xml/){$xml=1;}
0805 if($file ne "")
0806 {
0807 $outfile="";
0808 if(!open($outfile,">$file"))
0809 {
0810 print STDERR "Can not open file \"$file\" for writing. Going to print output on STDOUT.\n";
0811 $outfile=STDOUT;
0812 }
0813 else{$closefile=1;}
0814 }
0815 if(!$isPackage)
0816 {
0817 print $outfile "<$prodtype name=\"$prodname\" file=\"$filestr\">\n";
0818 $tab=" ";
0819 }
0820 my $edmplugin=0;
0821 if(($ccfiles>0) || ($isPackage))
0822 {
0823 if(exists $data->{deps}{src})
0824 {
0825 foreach my $dep (sort keys %{$data->{deps}{src}})
0826 {print $outfile "$tab<use name=\"$dep\"",&_xmlendtag($xml),">\n";}
0827 }
0828 foreach my $f (sort keys %{$data->{flags}})
0829 {
0830 if($f eq "EDM_PLUGIN"){$edmplugin=$data->{flags}{$f};}
0831 if(exists $data->{sflags}{$f})
0832 {
0833 my $v=$data->{flags}{$f};
0834 print $outfile "$tab<flags $f=\"$v\"",&_xmlendtag($xml),">\n";
0835 }
0836 else
0837 {
0838 foreach my $v (@{$data->{flags}{$f}})
0839 {
0840 if(exists $data->{keyflags}{$f})
0841 {
0842 my ($n,$v1)=split /=/,$v,2;
0843 if($v=~/^$n=/)
0844 {
0845 if($v1=~/^\"(.*?)\"$/){print $outfile "$tab<flags ${f}=\"${n}=\\\"$1\\\"\"";}
0846 else{print $outfile "$tab<flags ${f}=\"${n}=${v1}\"";}
0847 }
0848 else{print $outfile "$tab<flags ${f}=\"${n}\"";}
0849 }
0850 else{print $outfile "$tab<flags $f=\"$v\"";}
0851 print $outfile &_xmlendtag($xml),">\n";
0852 }
0853 }
0854 }
0855 }
0856 my %allarch=();
0857 foreach my $f (keys %{$data->{include_path}}){$allarch{$f}{include_path}=1;}
0858 foreach my $f (keys %{$data->{lib}}){$allarch{$f}{lib}=1;}
0859 foreach my $f (keys %{$data->{makefile}}){$allarch{$f}{makefile}=1;}
0860 foreach my $a (sort keys %allarch)
0861 {
0862 if($a ne "FORALLARCH"){print $outfile "$tab<architecture name=\"$a\">\n";$tab="$tab ";}
0863 if(exists $allarch{$a}{include_path})
0864 {foreach my $f (sort keys %{$data->{include_path}{$a}}){print $outfile "$tab<include_path path=\"$f\"",&_xmlendtag($xml),">\n";}}
0865 if(exists $allarch{$a}{lib})
0866 {foreach my $f (sort keys %{$data->{lib}{$a}}){print $outfile "$tab<lib name=\"$f\"",&_xmlendtag($xml),">\n";}}
0867 if(exists $allarch{$a}{makefile})
0868 {
0869 print $outfile "$tab<makefile>\n";
0870 foreach my $f (@{$data->{makefile}{$a}}){print $outfile "$f";}
0871 print $outfile "$tab</makefile>\n";
0872 }
0873 if($a ne "FORALLARCH"){$tab=~s/ $//;print $outfile "$tab</architecture>\n";}
0874 }
0875 if(!$isPackage){print $outfile "</$prodtype>\n";$tab="";}
0876 elsif(!$edmplugin)
0877 {
0878 print $outfile "<export>\n";
0879 my $hasexport=0;
0880 if(exists $data->{export})
0881 {
0882 my %allarch=();
0883 foreach my $a (keys %{$data->{export}{include_path}}){$allarch{$a}{include_path}=1;}
0884 foreach my $a (sort keys %allarch)
0885 {
0886 if($a ne "FORALLARCH"){print $outfile " <architecture name=\"$a\">\n";$tab=" ";$hasexport=1;}
0887 if(exists $allarch{$a}{include_path})
0888 {foreach my $f (sort keys %{$data->{export}{include_path}{$a}}){print $outfile "$tab <include_path path=\"$f\"",&_xmlendtag($xml),">\n";$hasexport=1;}}
0889 if($a ne "FORALLARCH"){$tab="";print $outfile " </architecture>\n";}
0890 }
0891 }
0892 if(($ccfiles>0) && ($edmplugin==0))
0893 {
0894 print $outfile " <lib name=\"1\"",&_xmlendtag($xml),">\n";
0895 $hasexport=1;
0896 }
0897 if(!$hasexport){print $outfile " <flags DummyFlagToAvoidWarning=\"0\"",&_xmlendtag($xml),">\n";}
0898 print $outfile "</export>\n";
0899 }
0900 if($closefile){close($outfile);}
0901 }
0902
0903 sub removeDuplicateTools ()
0904 {
0905 my $cache=shift;
0906 my $data=shift;
0907 foreach my $x ("src", "interface")
0908 {
0909 foreach my $t (keys %{$data->{deps}{$x}})
0910 {
0911 if((exists $cache->{TOOLS}{$t}) && (exists $cache->{TOOLS}{$t}{USE}))
0912 {foreach my $t1 (@{$cache->{TOOLS}{$t}{USE}}){delete $data->{deps}{$x}{$t1};}}
0913 }
0914 }
0915 }
0916
0917 sub removeExtraLib ()
0918 {
0919 my $cache=shift;
0920 my $data=shift;
0921 foreach my $a (keys %{$data->{lib}})
0922 {
0923 foreach my $lib (keys %{$data->{lib}{$a}})
0924 {
0925 foreach my $t (keys %{$data->{deps}{src}})
0926 {if(&isLibInTool($lib,$t,$cache)){delete $data->{lib}{$a}{$lib};last;}}
0927 }
0928 if(scalar(keys %{$data->{lib}{$a}})==0){delete $data->{lib}{$a};}
0929 }
0930 }
0931
0932 sub isLibInTool ()
0933 {
0934 my $lib=shift;
0935 my $tool=shift;
0936 my $cache=shift;
0937 if((exists $cache->{TOOLS}) && (exists $cache->{TOOLS}{$tool}))
0938 {
0939 if(exists $cache->{TOOLS}{$tool}{LIB})
0940 {
0941 foreach my $l (@{$cache->{TOOLS}{$tool}{LIB}})
0942 {if($lib eq $l){return 1;}}
0943 }
0944 if(exists $cache->{TOOLS}{$tool}{USE})
0945 {
0946 foreach my $t (@{$cache->{TOOLS}{$tool}{USE}})
0947 {if(&isLibInTool($lib,$t,$cache)){return 1;}}
0948 }
0949 }
0950 return 0;
0951 }
0952
0953
0954
0955
0956 sub searchIncFilesCXX ()
0957 {
0958 my $file=shift;
0959 my $data=shift;
0960 $data->{includes}={};
0961 my $cache=&readCXXFile($file);
0962 if(!exists $cache->{lines}){return;}
0963 my $total_lines=scalar(@{$cache->{lines}});
0964 for(my $i=0;$i<$total_lines;$i++)
0965 {
0966 my $line=$cache->{lines}[$i];
0967 while($line=~/\\\//){$line=~s/\\\//\//;}
0968 if ($line=~/^\s*#\s*include\s*([\"<](.+?)[\">])\s*/)
0969 {$data->{includes}{$2}=1;}
0970 }
0971 }
0972
0973 sub readCXXFile ()
0974 {
0975 my $file=shift;
0976 my $cache=shift || {};
0977 my $fref=0;
0978 if (!open ($fref, "$file"))
0979 {print STDERR "ERROR: Can not open file \"$file\" for reading.\n";return $cache;}
0980 $cache->{comment_type}=0;
0981 $cache->{string_started}=0;
0982 $cache->{lines}=[];
0983 $cache->{line_numbers}=[];
0984 $cache->{comments_lines}=0;
0985 $cache->{empty_lines}=0;
0986 $cache->{total_lines}=0;
0987 $cache->{code_lines}=0;
0988 while(my $line=<$fref>)
0989 {
0990 chomp $line;$line=~s/\r$//;
0991 &incData(\$cache->{total_lines});
0992
0993
0994 if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});next;}
0995
0996
0997 $cache->{tmp}{lines}=[];
0998 $cache->{tmp}{line_nums}=[];
0999 $cache->{tmp}{comments}=[];
1000 if ($line=~/^(.*?)\\$/)
1001 {
1002 my $pre=$1;
1003
1004
1005 if ($pre=~/^\s*$/){&incData(\$cache->{empty_lines});next;}
1006 while($line=<$fref>)
1007 {
1008 chomp $line;$line=~s/\r$//;
1009 &incData(\$cache->{total_lines});
1010 if ($line=~/^(.*?)\\$/)
1011 {
1012 $line=$1;
1013 if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});$pre="${pre}${line}";}
1014 else
1015 {
1016 push @{$cache->{tmp}{lines}}, $pre;
1017 push @{$cache->{tmp}{line_nums}}, $cache->{total_lines}-1;
1018 $pre=$line;
1019 }
1020 }
1021 else
1022 {
1023 if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});$line="${pre}${line}";}
1024 else
1025 {
1026 push @{$cache->{tmp}{lines}}, $pre;
1027 push @{$cache->{tmp}{line_nums}}, $cache->{total_lines}-1;
1028 }
1029 push @{$cache->{tmp}{lines}}, $line;
1030 push @{$cache->{tmp}{line_nums}}, $cache->{total_lines};
1031 last;
1032 }
1033 }
1034 }
1035 else
1036 {
1037 push @{$cache->{tmp}{lines}}, $line;
1038 push @{$cache->{tmp}{line_nums}}, $cache->{total_lines};
1039 }
1040 &removeCommentCXX ($cache);
1041 }
1042 close ($fref);
1043 delete $cache->{tmp};
1044 delete $cache->{comment_type};
1045 delete $cache->{string_started};
1046 $cache->{code_lines}=scalar(@{$cache->{lines}});
1047 return $cache;
1048 }
1049
1050 sub removeCommentCXX ()
1051 {
1052 my $cache=shift;
1053 my $e=scalar(@{$cache->{tmp}{lines}});
1054 if ($cache->{comment_type}==2){$cache->{comment_type}=0;}
1055 for(my $i=0; $i < $e; $i++)
1056 {
1057 my $line=$cache->{tmp}{lines}[$i];
1058 if ($cache->{comment_type} == 2)
1059 {
1060 $cache->{tmp}{lines}[$i]="";
1061 $cache->{string_started}=0;
1062 if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});$cache->{tmp}{comments}[$i]=0;}
1063 else{$cache->{tmp}{comments}[$i]=1;}
1064 }
1065 elsif ($cache->{comment_type} == 1)
1066 {
1067 $cache->{string_started}=0;
1068 if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});$cache->{tmp}{comments}[$i]=0;}
1069 elsif ($line=~/^(.*?)\*\/(.*)$/)
1070 {
1071 my $x=$1;
1072 $line=$2;
1073 $cache->{comment_type}=0;
1074 $cache->{tmp}{lines}[$i]=$line;
1075 &adjustCommentType1CXX($cache,$i,$line,$x);
1076 if ($line!~/^\s*$/){$i--;}
1077 }
1078 else{$cache->{tmp}{lines}[$i]="";$cache->{tmp}{comments}[$i]=1;}
1079 }
1080 else
1081 {
1082 &removeStringCXX ($cache);
1083 $line=$cache->{tmp}{lines}[$i];
1084 my $x1=undef; my $x2=undef;
1085 if ($line=~/^(.*?)\/\/(.*)$/){$line=$1;$x2=$2;}
1086 if ($line=~/^(.*?)\/\*(.*)$/)
1087 {
1088 $line=$1;
1089 $x1=$2;
1090 if(defined $x2){$x1.="//${x2}";$x2=undef;}
1091 }
1092 if(defined $x1){$i=removeCommentType1CXX ($cache,$i,$line,$x1);}
1093 elsif(defined $x2){if($x2!~/\s*INCLUDECHECKER\s*:\s*SKIP/i){$i=removeCommentType2CXX ($cache,$i,$line,$x2);}}
1094 elsif($cache->{tmp}{comments}[$i] eq ""){$cache->{tmp}{comments}[$i]=0;}
1095 }
1096 }
1097 for(my $i=0; $i < $e; $i++)
1098 {
1099 my $line=$cache->{tmp}{lines}[$i];
1100 $cache->{comments_lines}=$cache->{comments_lines}+$cache->{tmp}{comments}[$i];
1101 if ($line!~/^\s*$/)
1102 {
1103 push @{$cache->{lines}}, $line;
1104 push @{$cache->{line_numbers}}, $cache->{tmp}{line_nums}[$i];
1105 }
1106 }
1107 }
1108
1109 sub removeCommentType2CXX ()
1110 {
1111 my $cache=shift;
1112 my $i=shift;
1113 my $line=shift;
1114 my $x=shift;
1115 $cache->{tmp}{lines}[$i]=$line;
1116 $cache->{comment_type}=2;
1117 $cache->{string_started}=0;
1118 &adjustCommentType1CXX($cache,$i,$line,$x);
1119 return $i;
1120 }
1121
1122 sub removeCommentType1CXX ()
1123 {
1124 my $cache=shift;
1125 my $i=shift;
1126 my $line=shift;
1127 my $x=shift;
1128 $cache->{string_started}=0;
1129 my $ni=$i;
1130 if ($x=~s/^(.*?)\*\///)
1131 {
1132 $line="${line}${x}";
1133 $x=$1;
1134 if ($line!~/^\s*$/){$ni--;}
1135 }
1136 else{$cache->{comment_type}=1;}
1137 &adjustCommentType1CXX($cache,$i,$line,$x);
1138 $cache->{tmp}{lines}[$i]=$line;
1139 return $ni;
1140 }
1141
1142 sub adjustCommentType1CXX
1143 {
1144 my $cache=shift;
1145 my $i=shift;
1146 my $line=shift;
1147 my $x=shift;
1148 if ($x=~/[^\s]/){$cache->{tmp}{comments}[$i]=1;}
1149 if ($line=~/^\s*$/)
1150 {if(!$cache->{tmp}{comments}[$i]){&incData(\$cache->{empty_lines});$cache->{tmp}{comments}[$i]=0;}}
1151 elsif($cache->{tmp}{comments}[$i] eq ""){$cache->{tmp}{comments}[$i]=0;}
1152 }
1153
1154 sub removeStringCXX ()
1155 {
1156 my $cache=shift;
1157 my $lines=$cache->{tmp}{lines};
1158 my $str_started=$cache->{string_started};
1159 my $esc=0;
1160 my $e=scalar(@{$lines});
1161 for(my $i=0; $i < $e; $i++)
1162 {
1163 my $line=$lines->[$i];
1164 my $x1=length($line);
1165 if($line=~/^(.*?)\/\*(.*)$/){$x1=length($1);}
1166 if($line=~/^(.*?)\/\/(.*)$/)
1167 {
1168 my $x2=length($1);
1169 if ($x2 < $x1){$x1=$x2;}
1170 }
1171 my $nl="";
1172 my $j=-1;
1173 foreach my $ch (split //, $line)
1174 {
1175 $j++;
1176 if ($str_started)
1177 {
1178 if ($esc){$esc=0;}
1179 elsif($ch eq "\\"){$esc=1;}
1180 elsif ($ch eq '"'){$str_started=0;}
1181 elsif ($ch eq '/'){$nl="${nl}\\";}
1182 elsif ($ch eq '*'){$nl="${nl}\\";}
1183 }
1184 elsif(($ch eq '"') && ($j < $x1)){$str_started=1;}
1185 $nl="${nl}${ch}";
1186 }
1187 $lines->[$i]=$nl;
1188 }
1189 $cache->{string_started}=$str_started;
1190 }
1191
1192 sub skipIfDirectiveCXX ()
1193 {
1194 my $data=shift;
1195 my $s=shift;
1196 my $e=shift;
1197 my $i=$s;
1198 for(;$i<$e;$i++)
1199 {
1200 my $line=$data->[$i];
1201 if ($line=~/^\s*
1202 {$i=&skipIfDirectiveCXX ($data, $i+1, $e);}
1203 elsif($line=~/^\s*#\s*endif\s*/){last;}
1204 }
1205 return $i;
1206 }
1207
1208 sub searchPreprocessedFile ()
1209 {
1210 my $file=shift;
1211 my $data=shift;
1212 my $xflags=shift || "";
1213 my $ofile=shift || "";
1214 my %search=();
1215 my $hasfilter=0;
1216 my $delfile=0;
1217 foreach my $k (keys %{$data->{PROD_TYPE_SEARCH_RULES}})
1218 {if(!exists $data->{PROD_TYPE_SEARCH_RULES}{$k}{file}){$search{$k}=1;$hasfilter=1;}}
1219 if(!$hasfilter){return;}
1220 if($ofile eq ""){$ofile=&generatePreprocessedCXX($file,$data,$xflags);$delfile=1;}
1221 if($ofile eq ""){return;}
1222 if(!open(OFILE,"$ofile"))
1223 {
1224 print STDERR "Can not open file \"$ofile\" for reading.";
1225 if($delfile){my $d=dirname($ofile);system("rm -rf $d");}
1226 exit 0;
1227 }
1228 my $ref=0;
1229 if(ref($file) eq "ARRAY"){$ref=1;}
1230 while(my $line=<OFILE>)
1231 {
1232 chomp $line;
1233 if ($ref && ($line=~/^const char\* CreateBuildFileScriptVariable_$$\d+=\"([^"]+)";$/)){$file=$1;next;}
1234 foreach my $k (keys %search)
1235 {
1236 foreach my $f (keys %{$data->{PROD_TYPE_SEARCH_RULES}{$k}{filter}})
1237 {
1238 if($line=~/$f/)
1239 {
1240 $data->{PROD_TYPE_SEARCH_RULES}{$k}{file}=$file;
1241 delete $search{$k};
1242 last;
1243 }
1244 }
1245 }
1246 if(scalar(keys %search)==0){last;}
1247 }
1248 close(OFILE);
1249 if($delfile){my $d=dirname($ofile);system("rm -rf $d");}
1250 }
1251
1252 sub generatePreprocessedCXX ()
1253 {
1254 my $file=shift;
1255 my $data=shift;
1256 my $xflags=shift || "";
1257 my $compilecmd=$data->{compilecmd};
1258 if($compilecmd ne "")
1259 {
1260 my $cflags=$data->{compileflags}." ".$xflags;
1261 my $tmpdir=&getTmpDir();
1262 my $ofile="${tmpdir}/preprocessed.$$";
1263 my $fname="${ofile}.cc";
1264 my $xincs={};
1265 if (ref($file) eq "ARRAY")
1266 {
1267 foreach my $f (@$file){$xincs->{dirname($f)}=1;}
1268 $xincs=join(" -I",keys %$xincs);
1269 system("touch $fname; x=0; for f in ".join(" ",@$file)."; do echo \"const char* CreateBuildFileScriptVariable_$$\$x=\\\"\$f\\\";\" >> $fname; cat \$f >> $fname; x=`expr \$x + 1`; done");
1270 }
1271 else{system("cp $file $fname");}
1272 my @output=`$compilecmd -I$xincs $cflags -E -o $ofile $fname 2>&1`;
1273 my $err=$?;
1274 if ($err==0){return $ofile;}
1275 my %incs=();
1276 foreach my $l (@output)
1277 {
1278 chomp $l;
1279 print STDERR "$l\n";
1280 if ($l=~/:\s*([^\s:]+)\s*:\s*No such file or directory\s*$/i){$incs{$1}=1;}
1281 }
1282 if (scalar(keys %incs)>0)
1283 {
1284 my $iref;my $oref;
1285 if (open($iref,$fname))
1286 {
1287 if (open($oref,">${fname}.new"))
1288 {
1289 while(my $line=<$iref>)
1290 {
1291 chomp $line;
1292 if ($line=~/^\s*#\s*include\s*(<|")([^>"]+)(>|")/)
1293 {
1294 if (exists $incs{$2})
1295 {
1296 $line="//$line";
1297 print STDERR "Commecting out: $2\n";
1298 }
1299 }
1300 print $oref "$line\n";
1301 }
1302 close($oref);
1303 }
1304 close($iref);
1305 if (-f "${fname}.new")
1306 {
1307 system("cp ${fname}.new $fname");
1308 if(system("$compilecmd -I$xincs $cflags -E -o $ofile $fname")==0){return $ofile;}
1309 }
1310 }
1311 }
1312 return $fname;
1313 }
1314 return "";
1315 }
1316
1317 sub symbolChecking ()
1318 {
1319 my $lib=shift || return 0;
1320 my $d=dirname($lib);
1321 my $rel=&scramReleaseTop($d);
1322 if($rel eq ""){return 1;}
1323 my $cxx="";
1324 my $ld_path="";
1325 foreach my $f ("CXX", "CXXFLAGS", "CXXSHAREDOBJECTFLAGS", "LDFLAGS", "LD_LIBRARY_PATH")
1326 {
1327 my $val="";
1328 if(exists $InternalCache->{$rel}{BuildVariables}{$f})
1329 {$val=$InternalCache->{$rel}{BuildVariables}{$f};}
1330 else
1331 {
1332 $val=&getBuildVariable($d,$f);
1333 $InternalCache->{$rel}{BuildVariables}{$f}=$val;
1334 $InternalCache->{dirty}=1;
1335 }
1336 if($f eq "LD_LIBRARY_PATH"){$ld_path=$val;}
1337 else{$cxx.=" $val";}
1338 }
1339 if($ld_path ne ""){$cxx="LD_LIBRARY_PATH=$ld_path; export LD_LIBRARY_PATH; $cxx";}
1340 $cxx.=" -L$d";
1341 my $l=basename($lib); $l=~s/^lib(.+?)\.so$/$1/;
1342 my $tmpd=&getTmpDir();
1343 my $tmpf="${tmpd}/$l.cpp";
1344 system("echo \"int main(){}\" > $tmpf");
1345 print ">> Checking for missing symbols.\n";
1346 if($DEBUG){print "$cxx -o ${tmpf}.out -l$l $tmpf\n";}
1347 my @lines=`$cxx -o ${tmpf}.out -l$l $tmpf 2>&1`;
1348 my $ret=$?;
1349 system("rm -rf $tmpd");
1350 if($ret != 0)
1351 {
1352 $ret=0;
1353 print @lines;
1354 foreach my $line (@lines)
1355 {
1356 chomp $line;
1357 if($line=~/\/lib${l}\.so:\s+undefined reference to\s+/){return 1;}
1358 }
1359 }
1360 return $ret;
1361 }
1362
1363 sub leftAdjust {
1364 my $i;
1365 my $data=shift;
1366 my $width=shift;
1367 if(length($data)<$width){
1368 for($i=length($data);$i<$width;$i++){
1369 $data="$data ";
1370 }
1371 }
1372 return $data;
1373 }
1374
1375 sub rightAdjust {
1376 my $i;
1377 my $data=shift;
1378 my $width=shift;
1379 if(length($data)<$width){
1380 for($i=length($data);$i<$width;$i++){
1381 $data=" $data";
1382 }
1383 }
1384 return $data;
1385 }
1386
1387 sub setPrecision {
1388 my $num=shift;
1389 my $prec=shift;
1390 if($num=~/[^.]+\./){
1391 if($num=~s/([^.]+\.(\d{0,$prec}))\d*/$1/){ $l=length($2);}
1392 }
1393 else { $num="$num."; $l=0;}
1394 for($i=$l;$i<$prec;$i++){$num="${num}0";}
1395 chomp $num;
1396 return $num;
1397 }
1398
1399 sub incData ()
1400 {
1401 my $data=shift;
1402 $$data=$$data+(shift || 1);
1403 }
1404
1405 sub startTimer ()
1406 {
1407 my $msg=shift;
1408 my $info=shift || 0;
1409 my $time=&getTime();
1410 my $id=0;
1411 while(exists $Cache->{TIMERS}{"${time}.$$.${id}"}){$id++;}
1412 $id="${time}.$$.${id}";
1413 $Cache->{TIMERS}{$id}{start}=$time;
1414 $Cache->{TIMERS}{$id}{info}=$info;
1415 if($info)
1416 {
1417 $Cache->{TIMERS}{$id}{msg}=$msg;
1418 print STDERR "TIMER STARTED($id):$msg\n";
1419 }
1420 return $id;
1421 }
1422
1423 sub stopTimer()
1424 {
1425 my $id=shift;
1426 my $time=undef;
1427 if (exists $Cache->{TIMERS}{$id})
1428 {
1429 $time=&getTime() - $Cache->{TIMERS}{$id}{start};
1430 if ($Cache->{TIMERS}{$id}{info})
1431 {
1432 my $msg=shift || $Cache->{TIMERS}{$id}{msg};
1433 print STDERR "TIMER STOPED ($id):$msg:$time\n";
1434 }
1435 delete $Cache->{TIMERS}{$id};
1436 }
1437 return $time;
1438 }
1439
1440 sub timePassed ()
1441 {
1442 my $id=shift;
1443 my $time=undef;
1444 if (exists $Cache->{TIMERS}{$id}){$time=&getTime() - $Cache->{TIMERS}{$id}{start};}
1445 return $time;
1446 }
1447
1448 sub getTime ()
1449 {
1450 if(!exists $Cache->{HiResLoaded})
1451 {
1452 eval "require Time::HiRes";
1453 if(!$@){$Cache->{HiResLoaded}=1;}
1454 else{$Cache->{HiResLoaded}=0;}
1455 }
1456 my $time=undef;
1457 if ($Cache->{HiResLoaded}){$time=Time::HiRes::gettimeofday();}
1458 else{$time=`date +\%s.\%N`; chomp $time;}
1459 return $time;
1460 }
1461
1462 sub toolSymbolCache ()
1463 {
1464 my $cache=shift;
1465 my $tool=shift;
1466 if (!exists $cache->{SETUP}{$tool}){return;}
1467 my $dir=shift;
1468 my $jobs=shift || 1;
1469 print STDERR ".";
1470 if(exists $cache->{SETUP}{$tool}{LIB})
1471 {
1472 my $dirs=&searchBaseToolPaths($cache,$tool,"LIBDIR");
1473 foreach my $l (@{$cache->{SETUP}{$tool}{LIB}})
1474 {
1475 foreach my $d (@$dirs)
1476 {
1477 my $lib="${d}/lib${l}.so";
1478 if(!-f $lib){$lib="${d}/lib${l}.a";}
1479 if(-f $lib)
1480 {
1481 &symbolCacheFork($lib,$tool,$dir,$jobs);
1482 last;
1483 }
1484 }
1485 }
1486 }
1487 elsif($tool eq "cxxcompiler")
1488 {
1489 my $base=$cache->{SETUP}{$tool}{GCC_BASE} || $cache->{SETUP}{$tool}{CXXCOMPILER_BASE};
1490 if (($base ne "") && (-f "${base}/lib/libstdc++.so"))
1491 {
1492 &symbolCacheFork("${base}/lib/libstdc++.so","system",$dir,$jobs);
1493 foreach my $ldd (`ldd ${base}/lib/libstdc++.so`)
1494 {
1495 chomp $ldd;
1496 if ($ldd=~/\=\>\s+([^\s]+)\s+\(0x[0-9a-f]+\)\s*$/)
1497 {
1498 $ldd=$1;
1499 if (-f $ldd){&symbolCacheFork($ldd,"system",$dir,$jobs);}
1500 }
1501 }
1502 }
1503 }
1504 }
1505
1506 sub scramToolSymbolCache ()
1507 {
1508 my $cache=shift;
1509 my $tool=shift;
1510 if (!exists $cache->{SETUP}{$tool}){return;}
1511 my $dir=shift;
1512 my $jobs=shift || 1;
1513 my $libmap=shift;
1514 my $count=-1;
1515 foreach my $p (keys %$libmap)
1516 {
1517 my $l=$libmap->{$p};
1518 foreach my $d (@{$cache->{SETUP}{$tool}{LIBDIR}})
1519 {
1520 my $lib="${d}/lib${l}.so";
1521 if(!-f $lib){$lib="${d}/lib${l}.a";}
1522 if(-f $lib)
1523 {
1524 $count++;
1525 if (($count%100)==0){print STDERR ".";}
1526 &symbolCacheFork($lib,$p,$dir,$jobs);
1527 last;
1528 }
1529 }
1530 }
1531 }
1532
1533 sub searchBaseToolPaths ()
1534 {
1535 my $cache=shift;
1536 my $tool=shift;
1537 my $var=shift;
1538 my $paths=shift || [];
1539 if(exists $cache->{SETUP}{$tool})
1540 {
1541 my $c=$cache->{SETUP}{$tool};
1542 if(exists $c->{$var}){foreach my $d (@{$c->{$var}}){push @$paths,$d;}}
1543 if(exists $c->{USE}){foreach my $u (@{$c->{USE}}){&searchBaseToolPaths($cache,lc($u),$var,$paths);}}
1544 if (($var eq "LIBDIR") && (scalar(@$paths)==0) && ((!exists $c->{SCRAM_COMPILER}) || ($c->{SCRAM_COMPILER}==0)))
1545 {push @$paths,"/lib64","/usr/lib64","/lib","/usr/lib";}
1546 }
1547 return $paths;
1548 }
1549
1550 sub symbolCacheFork ()
1551 {
1552 my $lib=shift;
1553 my $t1=(stat($lib))[9];
1554 my $tool=shift;
1555 my $dir=shift;
1556 my $lname=basename($lib);
1557 my $pk=$tool;$pk=~s/\///g;
1558 my $cfile="${dir}/${lname}.${pk}";
1559 if ((stat($cfile)) && ((stat(_))[9] == $t1)){$Cache->{SYMBOL_CACHE_UPDATED}=$t1; return 0;}
1560 my $jobs=shift;
1561 if ($jobs > 1)
1562 {
1563 my $pid=&forkProcess($jobs);
1564 if($pid==0){&_symbolCache($lib,$cfile,$t1,$tool,$lname);exit 0;}
1565 }
1566 else{&_symbolCache($lib,$cfile,$t1,$tool,$lname);}
1567 $Cache->{SYMBOL_CACHE_UPDATED}=$t1;
1568 return 1;
1569 }
1570
1571 sub _symbolCache ()
1572 {
1573 my $lib=shift;
1574 my $cfile=shift;
1575 my $time=shift;
1576 my $tool=shift;
1577 my $lname=shift;
1578 my $shared="";
1579 if($lib=~/\.so$/){$shared="-D";}
1580 my $c={};
1581 my $fil="[A-Za-z]";
1582 foreach my $line (`nm $shared $lib`)
1583 {
1584 chomp $line;
1585 if($line=~/\s+($fil)\s+(.+)$/){$c->{$tool}{$lname}{$1}{$2}=1;}
1586 }
1587 &writeHashCache($c,$cfile);
1588 utime($time,$time,$cfile);
1589 }
1590
1591 sub mergeSymbols ()
1592 {
1593 my $dir=shift;
1594 my $file=shift || "";
1595 my $filter=shift || "T|R|V|W|B|D";
1596 my $cache={};
1597 if(-d $dir)
1598 {
1599 print STDERR "Merging symbols $dir ($filter) ....";
1600 my $ltime=0;
1601 if ($file ne "")
1602 {
1603 $ltime=$Cache->{SYMBOL_CACHE_UPDATED} || time;
1604 if ((stat($file)) && ((stat(_))[9] == $ltime)){print STDERR "\n";return &readHashCache($file);}
1605 }
1606 my $count=0;
1607 my $r;
1608 opendir($r,$dir) || die "Can not open directory for reading: $dir\n";
1609 foreach my $f (readdir($r))
1610 {
1611 if ($f=~/^\./){next;}
1612 $count++;
1613 if(($count%100)==0){print STDERR ".";}
1614 my $c=&readHashCache("${dir}/${f}");
1615 foreach my $t (keys %$c)
1616 {
1617 foreach my $l (keys %{$c->{$t}})
1618 {
1619 foreach my $x (keys %{$c->{$t}{$l}})
1620 {
1621 if ($x=~/^$filter$/)
1622 {
1623 foreach my $s (keys %{$c->{$t}{$l}{$x}}){$cache->{$s}{$t}{$l}=$x;}
1624 }
1625 }
1626 }
1627 }
1628 }
1629 if ($file ne "")
1630 {
1631 &writeHashCache($cache,"$file");
1632 utime($ltime,$ltime,$file);
1633 }
1634 }
1635 print STDERR "\n";
1636 return $cache;
1637 }
1638
1639 sub cppFilt ()
1640 {
1641 my $s=shift;
1642 if (exists $Cache->{CPPFLIT}{$s}){return $Cache->{CPPFLIT}{$s};}
1643 my $s1=`c++filt $s`; chomp $s1;
1644 $Cache->{CPPFLIT}{$s}=$s1;
1645 return $s1;
1646 }
1647
1648 sub _symDir ()
1649 {
1650 my $sym=shift;
1651 my $d="";
1652 my $c=1;
1653 while($sym=~s/^(.{$c})//){$d.="/$1";if($c<8){$c++;}}
1654 return "${d}/${sym}";
1655 }
1656
1657 sub forkProcess ()
1658 {
1659 my $limit=shift || 1;
1660 &waitForChild($limit-1);
1661 my $pid=0;
1662 my $err=0;
1663 do
1664 {
1665 $pid = fork ();
1666 if (!defined $pid)
1667 {
1668 $err++;
1669 print STDERR "WARNING: Can not fork a new process:$err: $@\n";
1670 if ($err > 10 ){die "ERROR: Exiting due to fork() failure.\n";}
1671 }
1672 } while (!defined $pid);
1673 if ($pid>0){$Cache->{FORK}{pids}{$pid}=1;$Cache->{FORK}{running}=$Cache->{FORK}{running}+1;}
1674 return $pid;
1675 }
1676
1677 sub waitForChild ()
1678 {
1679 use POSIX ":sys_wait_h";
1680 my $limit=shift || 0;
1681 my $running=$Cache->{FORK}{running} || 0;
1682 while ($running>$limit)
1683 {
1684 my $pid=-1;
1685 do
1686 {
1687 $pid = waitpid(-1, WNOHANG);
1688 if (exists $Cache->{FORK}{pids}{$pid}) { $running--; delete $Cache->{FORK}{pids}{$pid};}
1689 } while ($pid > 0);
1690 if ($running>$limit){sleep 1;}
1691 }
1692 $Cache->{FORK}{running}=$running;
1693 }
1694
1695
1696 sub makeRequest ()
1697 {
1698 my $dir=shift;
1699 my $msg=shift;
1700 my $file=&getTmpFile($dir);
1701 unlink $file;
1702 &writeMsg("${file}.REQUEST",$msg);
1703 my $reply="";
1704 while (1)
1705 {
1706 if (!-f "${file}.REPLY.DONE"){next;}
1707 $reply=&readMsg("${file}.REPLY");
1708 last;
1709 }
1710 return $reply;
1711 }
1712
1713 sub readRequests()
1714 {
1715 my $dir=shift;
1716 my $req={};
1717 my $ref;
1718 opendir ($ref,$dir) || die "Can not open directory for reading: $dir\n";
1719 foreach my $f (readdir($ref)){if ($f=~/^((.+)\.REQUEST)\.DONE$/){$req->{"${dir}/${2}.REPLY"}=&readMsg("${dir}/${1}");}}
1720 closedir($ref);
1721 return $req;
1722 }
1723
1724 sub readMsg ()
1725 {
1726 my $file=shift;
1727 my $ref;
1728 open($ref,$file) || die "Can not open file for reading:$file\n";
1729 my $input=<$ref>; chomp $input;
1730 close($ref);
1731 unlink $file;
1732 unlink "$file.DONE";
1733 return $input;
1734 }
1735
1736 sub writeMsg ()
1737 {
1738 my $file=shift;
1739 my $msg=shift;
1740 my $ref;
1741 open($ref,">$file") || die "Can not open file for writing:$file\n";
1742 print $ref "$msg\n";
1743 close($ref);
1744 open($ref,">$file.DONE") || die "Can not open file for writing:$file.DONE\n";
1745 close($ref);
1746 }
1747
1748 sub writeJson()
1749 {
1750 my ($obj,$tab)=@_;
1751 my $str="";
1752 my $ref=ref($obj);
1753 my $indent=&_indent($tab);
1754 if ($ref eq "HASH")
1755 {
1756 $str="{";
1757 foreach my $k (sort keys %$obj){$str.="\n${indent} \"$k\": ".&writeJson($obj->{$k},$tab+length($k)+6);}
1758 chomp($str);
1759 $str=~s/, *$//;
1760 $str.="\n${indent}},";
1761 }
1762 elsif($ref eq "ARRAY")
1763 {
1764 $str.="[";
1765 foreach my $i (@$obj){$str.="\n${indent} ".&writeJson($i,$tab+2);chomp($str);}
1766 chomp($str);
1767 $str=~s/, *$//;
1768 $str.="\n${indent}],";
1769 }
1770 else{$str.="\"$obj\",";}
1771 return $str;
1772 }
1773
1774 sub _indent()
1775 {
1776 my $l=shift;
1777 my $s="";
1778 for(my $i=0;$i<$l;$i++){$s.=" ";}
1779 return $s;
1780 }
1781
1782 1;
