Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 13:33:03

0001 #!/bin/env perl
0002 #
0003 # A script to parse cfi files for parameters to replace
0004 # Probably not very stable...
0005 #
0006 
0007 
0008 ### To turn on verbosity, uncomment following line
0009 #open(MSG,">&STDERR") or die "Couldn't open stderr: $!";
0010 
0011 use strict;
0012 
0013 # Extract source name from argument
0014 my $config = $ARGV[0];
0015 (my $source = $config) =~ s/.*(CMSSW)/$1/;
0016 
0017 
0018 # Alignment of comments: column number
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 = ""; # Name of current block/module
0026 my $lineNb = 0;
0027 my $isMulti = 0;
0028 MAIN: while( <INPUT> ) {
0029   print MSG ++$lineNb."\n";
0030 
0031   # Skip empty lines
0032   next if (!/\S/);
0033 
0034   # Skip includes
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." # ".$comment;
0223   }
0224   print "replace $prefix.$name = $string";
0225 }