| 1 |
#!/bin/env perl
|
| 2 |
#
|
| 3 |
# A script to parse cfi files for parameters to replace
|
| 4 |
# Probably not very stable...
|
| 5 |
#
|
| 6 |
|
| 7 |
|
| 8 |
### To turn on verbosity, uncomment following line
|
| 9 |
#open(MSG,">&STDERR") or die "Couldn't open stderr: $!";
|
| 10 |
|
| 11 |
use strict;
|
| 12 |
|
| 13 |
# Extract source name from argument
|
| 14 |
my $config = $ARGV[0];
|
| 15 |
(my $source = $config) =~ s/.*(CMSSW)/$1/;
|
| 16 |
|
| 17 |
|
| 18 |
# Alignment of comments: column number
|
| 19 |
my $alignment = 60;
|
| 20 |
|
| 21 |
print "# Generated from $source\n";
|
| 22 |
print MSG "Parsing $source\n";
|
| 23 |
|
| 24 |
open(INPUT,$config) or die "Couldn't open $config: $!";
|
| 25 |
my $levelName = ""; # Name of current block/module
|
| 26 |
my $lineNb = 0;
|
| 27 |
my $isMulti = 0;
|
| 28 |
MAIN: while( <INPUT> ) {
|
| 29 |
print MSG ++$lineNb."\n";
|
| 30 |
|
| 31 |
# Skip empty lines
|
| 32 |
next if (!/\S/);
|
| 33 |
|
| 34 |
# Skip includes
|
| 35 |
next if ( /\s*include\s+\".*\"/ );
|
| 36 |
|
| 37 |
# Skip commented-out lines
|
| 38 |
next if (m@^\s*(//|#)@);
|
| 39 |
|
| 40 |
chomp();
|
| 41 |
my $line = $_; # Store line
|
| 42 |
|
| 43 |
while ( $line =~ /\S/ ) {
|
| 44 |
# 1. Process named blocks (modules, blocks, PSets)
|
| 45 |
($line,$levelName) = &processBlocks( $line, $levelName );
|
| 46 |
|
| 47 |
# 2. Skip VPSets and sequences
|
| 48 |
# NB. This is fragile!
|
| 49 |
if ( $line =~ /(VPSet|sequence)\s+(\S+)\s*=\s*\{\s*/ ) {
|
| 50 |
print MSG "Found $1 with name $2: skipping\n";
|
| 51 |
my $nBraces = 1; # Start with one, from above matching
|
| 52 |
$line = $';
|
| 53 |
$nBraces += &countBraces( $line );
|
| 54 |
print MSG "$nBraces: $line\n";
|
| 55 |
if ( $nBraces>0 ){
|
| 56 |
while ( <INPUT> ) {
|
| 57 |
$line = $_;
|
| 58 |
$nBraces += &countBraces( $line );
|
| 59 |
print MSG "$nBraces: $line\n";
|
| 60 |
last if ( $nBraces <= 0 );
|
| 61 |
}
|
| 62 |
}
|
| 63 |
$line = "";
|
| 64 |
next; # This assumes closing brace is last on line...
|
| 65 |
}
|
| 66 |
|
| 67 |
# 3. Process parameters (might be multiline)
|
| 68 |
($line,$isMulti) = &processParameters( $line, $levelName );
|
| 69 |
if ( $isMulti ) { # Treat mutliline separately...
|
| 70 |
while (<INPUT>) {
|
| 71 |
print MSG ++$lineNb."\n";
|
| 72 |
s/^\s+//; # Remove leading spaces
|
| 73 |
chomp();
|
| 74 |
$_ = &nukeComments( $_ ); # Remove comments in that case
|
| 75 |
if ( /.*?\}/ ) {
|
| 76 |
print $line.$&."\n"; # Dump what we have found
|
| 77 |
$line = $'; # Store remainder in line for future use
|
| 78 |
$isMulti = 0;
|
| 79 |
last;
|
| 80 |
} else {
|
| 81 |
$line .= $_;
|
| 82 |
}
|
| 83 |
}
|
| 84 |
print MSG "End of span\n";
|
| 85 |
}
|
| 86 |
|
| 87 |
# 4. Remove remaining comments on blocks
|
| 88 |
$line = &nukeComments( $line );
|
| 89 |
|
| 90 |
# 5. Climb up levels if braces are closed
|
| 91 |
($line,$levelName) = &closeBraces( $line, $levelName );
|
| 92 |
}
|
| 93 |
}
|
| 94 |
close(INPUT);
|
| 95 |
|
| 96 |
|
| 97 |
#_______________________________________________________________________
|
| 98 |
# Check line for new blocks and add them to level name
|
| 99 |
sub processBlocks {
|
| 100 |
|
| 101 |
my $line = shift;
|
| 102 |
my $levelName = shift;
|
| 103 |
|
| 104 |
if ( $line =~ /(module|block|[^V]PSet)\s+(\S+)\s*=\s*(\S+)?\s*\{\s*/ ) {
|
| 105 |
print MSG "Found $1 with name $2".($3?" and label $3":"")."\n";
|
| 106 |
$levelName .= (length($levelName)>0?'.':'').$2;
|
| 107 |
$line = $';
|
| 108 |
}
|
| 109 |
|
| 110 |
return ($line,$levelName);
|
| 111 |
}
|
| 112 |
|
| 113 |
|
| 114 |
#_______________________________________________________________________
|
| 115 |
# Check for new parameters
|
| 116 |
sub processParameters{
|
| 117 |
|
| 118 |
my $line = shift;
|
| 119 |
my $levelName = shift;
|
| 120 |
my $isMulti = 0;
|
| 121 |
|
| 122 |
if ( $line =~ /([\w\d]+)\s+(\S+)\s*=\s*(.*)$/ ) {
|
| 123 |
my $type = $1;
|
| 124 |
my $name = $2;
|
| 125 |
my $value = $3;
|
| 126 |
$line = $';
|
| 127 |
|
| 128 |
# Check for un-balanced closing brace and put back on line
|
| 129 |
if ( $value !~ /\{/ && $value =~ /\}/ ) {
|
| 130 |
$value = $`;
|
| 131 |
$line = '}'.$line;
|
| 132 |
}
|
| 133 |
|
| 134 |
print MSG "Found $type with name $name and value $value";
|
| 135 |
# Check if this parameter spans over several lines
|
| 136 |
if ( $value =~ /\{/ && $value !~ /\}/ ) {
|
| 137 |
$isMulti++;
|
| 138 |
print MSG " spanning over multiple lines";
|
| 139 |
$value = &nukeComments($value); # Don't keep comments in that case: too disturbing
|
| 140 |
}
|
| 141 |
print MSG "\n";
|
| 142 |
|
| 143 |
# Dump out
|
| 144 |
&dumpReplace($levelName,$name,$value);
|
| 145 |
if ( !$isMulti ) { print "\n"; }
|
| 146 |
|
| 147 |
}
|
| 148 |
|
| 149 |
|
| 150 |
return $line,$isMulti;
|
| 151 |
|
| 152 |
}
|
| 153 |
|
| 154 |
#_______________________________________________________________________
|
| 155 |
# Remove trailing comments from block definitions (can't carry them)
|
| 156 |
sub nukeComments {
|
| 157 |
|
| 158 |
my $line = shift;
|
| 159 |
|
| 160 |
if ( $line =~ m@\s*(//|#)@ ) {
|
| 161 |
$line = $`;
|
| 162 |
}
|
| 163 |
return $line;
|
| 164 |
|
| 165 |
}
|
| 166 |
|
| 167 |
#______________________________________________________________________
|
| 168 |
# Close braces and adjust levelName correspondingly
|
| 169 |
sub closeBraces {
|
| 170 |
|
| 171 |
my $line = shift;
|
| 172 |
my $levelName = shift;
|
| 173 |
|
| 174 |
if ( $line =~ /^\s*\}\s*/ ) {
|
| 175 |
my $curLevel = $levelName;
|
| 176 |
print MSG "Found closing brace - climbing up: '$levelName' -> ";
|
| 177 |
$levelName =~ s/\.[^\.]*?$//;
|
| 178 |
if ( $curLevel =~ /^$levelName$/ ) { # Treat special case...
|
| 179 |
$levelName = "";
|
| 180 |
}
|
| 181 |
$line = $';
|
| 182 |
print MSG "'$levelName'\n";
|
| 183 |
}
|
| 184 |
return ($line,$levelName);
|
| 185 |
|
| 186 |
}
|
| 187 |
|
| 188 |
#______________________________________________________________________
|
| 189 |
# Count number of braces
|
| 190 |
# Opening adds one, closing removes one
|
| 191 |
sub countBraces {
|
| 192 |
|
| 193 |
my $string = shift;
|
| 194 |
my $nBraces = 0;
|
| 195 |
my $char = "";
|
| 196 |
|
| 197 |
while ( length($string)>0 ) {
|
| 198 |
$char = chop($string);
|
| 199 |
++$nBraces if ( $char =~ /\{/ );
|
| 200 |
--$nBraces if ( $char =~ /\}/ );
|
| 201 |
}
|
| 202 |
|
| 203 |
return $nBraces;
|
| 204 |
|
| 205 |
}
|
| 206 |
|
| 207 |
|
| 208 |
#______________________________________________________________________
|
| 209 |
# Subroutine to nicely dump the replace statements
|
| 210 |
# Tries to align comments
|
| 211 |
sub dumpReplace {
|
| 212 |
my $prefix = shift; # Level name
|
| 213 |
my $name = shift; # Parameter name
|
| 214 |
my $string = shift; # Value, including possible comment
|
| 215 |
|
| 216 |
if ( $string =~ /(#|\/\/)\s*/ ) {
|
| 217 |
my $value = $`;
|
| 218 |
my $comment = $';
|
| 219 |
$value =~ s/\s+$//g; # Remove trailing spaces
|
| 220 |
# Alignment: add necessary spaces
|
| 221 |
while ( length($prefix.$name." = ".$value) < $alignment ) { $value .= " "; }
|
| 222 |
$string = $value." # ".$comment;
|
| 223 |
}
|
| 224 |
print "replace $prefix.$name = $string";
|
| 225 |
}
|
