Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 14:32:01

0001 package SCRAMGenUtils;
0002 use File::Basename;
0003 use Storable qw(nstore retrieve);
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*#/) || ($line=~/^\s*$/)){next;}
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       #if($DEBUG){print STDERR "#Configuring=>$line\n";}
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 # Reading Project Cache DB
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*#/)){next;}
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 # Reading writing cache files
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 # Find SCRAM based release area
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 # Shared lib functions
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 #SCRAM BuildFile
0527 
0528 ##########################################################
0529 # Read BuildFile
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*(#.*|)$/){next;}
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 # Read C/C++ file
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     #check for empty line
0994     if ($line=~/^\s*$/){&incData(\$cache->{empty_lines});next;}
0995     
0996     #combine all lines which ends with /
0997     $cache->{tmp}{lines}=[];
0998     $cache->{tmp}{line_nums}=[];
0999     $cache->{tmp}{comments}=[];
1000     if ($line=~/^(.*?)\\$/)
1001     {
1002       my $pre=$1;
1003       
1004       #check for empty line
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*#\s*if(n|\s+|)def(ined|\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;