File indexing completed on 2024-04-06 12:23:58
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011 use strict;
0012
0013
0014 my $config = $ARGV[0];
0015 (my $source = $config) =~ s/.*(CMSSW)/$1/;
0016
0017
0018
0019 my $alignment = 60;
0020
0021 print "# Generated from $source\n";
0022 print MSG "Parsing $source\n";
0023
0024 open(INPUT,$config) or die "Couldn't open $config: $!";
0025 my $levelName = "";
0026 my $lineNb = 0;
0027 my $isMulti = 0;
0028 MAIN: while( <INPUT> ) {
0029 print MSG ++$lineNb."\n";
0030
0031
0032 next if (!/\S/);
0033
0034
0035 next if ( /\s*include\s+\".*\"/ );
0036
0037 # Skip commented-out lines
0038 next if (m@^\s*(//|#)@);
0039
0040 chomp();
0041 my $line = $_; # Store line
0042
0043 while ( $line =~ /\S/ ) {
0044 # 1. Process named blocks (modules, blocks, PSets)
0045 ($line,$levelName) = &processBlocks( $line, $levelName );
0046
0047 # 2. Skip VPSets and sequences
0048 # NB. This is fragile!
0049 if ( $line =~ /(VPSet|sequence)\s+(\S+)\s*=\s*\{\s*/ ) {
0050 print MSG "Found $1 with name $2: skipping\n";
0051 my $nBraces = 1; # Start with one, from above matching
0052 $line = $';
0053 $nBraces += &countBraces( $line );
0054 print MSG "$nBraces: $line\n";
0055 if ( $nBraces>0 ){
0056 while ( <INPUT> ) {
0057 $line = $_;
0058 $nBraces += &countBraces( $line );
0059 print MSG "$nBraces: $line\n";
0060 last if ( $nBraces <= 0 );
0061 }
0062 }
0063 $line = "";
0064 next; # This assumes closing brace is last on line...
0065 }
0066
0067 # 3. Process parameters (might be multiline)
0068 ($line,$isMulti) = &processParameters( $line, $levelName );
0069 if ( $isMulti ) { # Treat mutliline separately...
0070 while (<INPUT>) {
0071 print MSG ++$lineNb."\n";
0072 s/^\s+//; # Remove leading spaces
0073 chomp();
0074 $_ = &nukeComments( $_ ); # Remove comments in that case
0075 if ( /.*?\}/ ) {
0076 print $line.$&."\n"; # Dump what we have found
0077 $line = $'; # Store remainder in line for future use
0078 $isMulti = 0;
0079 last;
0080 } else {
0081 $line .= $_;
0082 }
0083 }
0084 print MSG "End of span\n";
0085 }
0086
0087 # 4. Remove remaining comments on blocks
0088 $line = &nukeComments( $line );
0089
0090 # 5. Climb up levels if braces are closed
0091 ($line,$levelName) = &closeBraces( $line, $levelName );
0092 }
0093 }
0094 close(INPUT);
0095
0096
0097 #_______________________________________________________________________
0098 # Check line for new blocks and add them to level name
0099 sub processBlocks {
0100
0101 my $line = shift;
0102 my $levelName = shift;
0103
0104 if ( $line =~ /(module|block|[^V]PSet)\s+(\S+)\s*=\s*(\S+)?\s*\{\s*/ ) {
0105 print MSG "Found $1 with name $2".($3?" and label $3":"")."\n";
0106 $levelName .= (length($levelName)>0?'.':'').$2;
0107 $line = $';
0108 }
0109
0110 return ($line,$levelName);
0111 }
0112
0113
0114 #_______________________________________________________________________
0115 # Check for new parameters
0116 sub processParameters{
0117
0118 my $line = shift;
0119 my $levelName = shift;
0120 my $isMulti = 0;
0121
0122 if ( $line =~ /([\w\d]+)\s+(\S+)\s*=\s*(.*)$/ ) {
0123 my $type = $1;
0124 my $name = $2;
0125 my $value = $3;
0126 $line = $';
0127
0128 # Check for un-balanced closing brace and put back on line
0129 if ( $value !~ /\{/ && $value =~ /\}/ ) {
0130 $value = $`;
0131 $line = '}'.$line;
0132 }
0133
0134 print MSG "Found $type with name $name and value $value";
0135 # Check if this parameter spans over several lines
0136 if ( $value =~ /\{/ && $value !~ /\}/ ) {
0137 $isMulti++;
0138 print MSG " spanning over multiple lines";
0139 $value = &nukeComments($value); # Don't keep comments in that case: too disturbing
0140 }
0141 print MSG "\n";
0142
0143 # Dump out
0144 &dumpReplace($levelName,$name,$value);
0145 if ( !$isMulti ) { print "\n"; }
0146
0147 }
0148
0149
0150 return $line,$isMulti;
0151
0152 }
0153
0154 #_______________________________________________________________________
0155 # Remove trailing comments from block definitions (can't carry them)
0156 sub nukeComments {
0157
0158 my $line = shift;
0159
0160 if ( $line =~ m@\s*(//|#)@ ) {
0161 $line = $`;
0162 }
0163 return $line;
0164
0165 }
0166
0167 #______________________________________________________________________
0168 # Close braces and adjust levelName correspondingly
0169 sub closeBraces {
0170
0171 my $line = shift;
0172 my $levelName = shift;
0173
0174 if ( $line =~ /^\s*\}\s*/ ) {
0175 my $curLevel = $levelName;
0176 print MSG "Found closing brace - climbing up: '$levelName' -> ";
0177 $levelName =~ s/\.[^\.]*?$//;
0178 if ( $curLevel =~ /^$levelName$/ ) { # Treat special case...
0179 $levelName = "";
0180 }
0181 $line = $';
0182 print MSG "'$levelName'\n";
0183 }
0184 return ($line,$levelName);
0185
0186 }
0187
0188 #______________________________________________________________________
0189 # Count number of braces
0190 # Opening adds one, closing removes one
0191 sub countBraces {
0192
0193 my $string = shift;
0194 my $nBraces = 0;
0195 my $char = "";
0196
0197 while ( length($string)>0 ) {
0198 $char = chop($string);
0199 ++$nBraces if ( $char =~ /\{/ );
0200 --$nBraces if ( $char =~ /\}/ );
0201 }
0202
0203 return $nBraces;
0204
0205 }
0206
0207
0208 #______________________________________________________________________
0209 # Subroutine to nicely dump the replace statements
0210 # Tries to align comments
0211 sub dumpReplace {
0212 my $prefix = shift; # Level name
0213 my $name = shift; # Parameter name
0214 my $string = shift; # Value, including possible comment
0215
0216 if ( $string =~ /(#|\/\/)\s*/ ) {
0217 my $value = $`;
0218 my $comment = $';
0219 $value =~ s/\s+$//g; # Remove trailing spaces
0220 # Alignment: add necessary spaces
0221 while ( length($prefix.$name." = ".$value) < $alignment ) { $value .= " "; }
0222 $string = $value."
0223 }
0224 print "replace $prefix.$name = $string";
0225 }