PatAlgos/scripts/patReplaceParser.pl

#!/bin/env perl
#
# A script to parse cfi files for parameters to replace
# Probably not very stable...
#


### To turn on verbosity, uncomment following line
#open(MSG,">&STDERR") or die "Couldn't open stderr: $!";

use strict;

# Extract source name from argument
my $config = $ARGV[0];
(my $source = $config) =~ s/.*(CMSSW)/$1/;


# Alignment of comments: column number
my $alignment = 60;

print "# Generated from $source\n";
print MSG "Parsing  $source\n";

open(INPUT,$config) or die "Couldn't open $config: $!";
my $levelName = ""; # Name of current block/module
my $lineNb = 0;
my $isMulti = 0;
MAIN: while( <INPUT> ) {
  print MSG ++$lineNb."\n";

  # Skip empty lines
  next if (!/\S/);

  # Skip includes
  next if ( /\s*include\s+\".*\"/ );

  # Skip commented-out lines
  next if (m@^\s*(//|#)@);

  chomp();
  my $line = $_; # Store line

  while ( $line =~ /\S/ ) {
    # 1. Process named blocks (modules, blocks, PSets)
    ($line,$levelName) = &processBlocks( $line, $levelName );

    # 2. Skip VPSets and sequences
    #    NB. This is fragile!
    if ( $line =~ /(VPSet|sequence)\s+(\S+)\s*=\s*\{\s*/ ) {
      print MSG "Found $1 with name $2: skipping\n";
      my $nBraces = 1; # Start with one, from above matching
      $line = $';
      $nBraces += &countBraces( $line );
      print MSG "$nBraces: $line\n";
      if ( $nBraces>0 ){
        while ( <INPUT> ) {
          $line = $_;
          $nBraces += &countBraces( $line );
          print MSG "$nBraces: $line\n";
          last if ( $nBraces <= 0 );
        }
      }
      $line = "";
      next;       # This assumes closing brace is last on line...
    }

    # 3. Process parameters (might be multiline)
    ($line,$isMulti) = &processParameters( $line, $levelName );
    if ( $isMulti ) { # Treat mutliline separately...
      while (<INPUT>) {
        print MSG ++$lineNb."\n";
        s/^\s+//; # Remove leading spaces
        chomp();
        $_ = &nukeComments( $_ ); # Remove comments in that case
        if ( /.*?\}/ ) {
          print $line.$&."\n"; # Dump what we have found
          $line = $';     # Store remainder in line for future use
          $isMulti = 0;
          last;
        } else {
          $line .= $_;
        }
      }
      print MSG "End of span\n";
    }

    # 4. Remove remaining comments on blocks
    $line = &nukeComments( $line );

    # 5. Climb up levels if braces are closed
    ($line,$levelName) = &closeBraces( $line, $levelName );
  }
}
close(INPUT);


#_______________________________________________________________________
# Check line for new blocks and add them to level name
sub processBlocks {

  my $line = shift;
  my $levelName = shift;

  if ( $line =~ /(module|block|[^V]PSet)\s+(\S+)\s*=\s*(\S+)?\s*\{\s*/ ) {
    print MSG "Found $1 with name $2".($3?" and label $3":"")."\n";
    $levelName .= (length($levelName)>0?'.':'').$2;
    $line = $';
  }

  return ($line,$levelName);
}


#_______________________________________________________________________
# Check for new parameters
sub processParameters{

  my $line = shift;
  my $levelName = shift;
  my $isMulti = 0;

  if ( $line =~ /([\w\d]+)\s+(\S+)\s*=\s*(.*)$/ ) {
    my $type = $1;
    my $name = $2;
    my $value = $3;
    $line = $';

    # Check for un-balanced closing brace and put back on line
    if ( $value !~ /\{/ && $value =~ /\}/ ) {
      $value = $`;
      $line = '}'.$line;
    }

    print MSG "Found $type with name $name and value $value";
    # Check if this parameter spans over several lines
    if ( $value =~ /\{/ && $value !~ /\}/ ) {
      $isMulti++;
      print MSG " spanning over multiple lines";
      $value = &nukeComments($value); # Don't keep comments in that case: too disturbing
    }
    print MSG "\n";

    # Dump out
    &dumpReplace($levelName,$name,$value);
    if ( !$isMulti ) { print "\n"; }

  }


  return $line,$isMulti;

}

#_______________________________________________________________________
# Remove trailing comments from block definitions (can't carry them)
sub nukeComments {

  my $line = shift;

  if ( $line =~ m@\s*(//|#)@ ) {
    $line = $`;
  }
  return $line;

} 

#______________________________________________________________________
# Close braces and adjust levelName correspondingly
sub closeBraces {

  my $line = shift;
  my $levelName = shift;

  if ( $line =~ /^\s*\}\s*/ ) {
    my $curLevel = $levelName;
    print MSG "Found closing brace - climbing up: '$levelName' -> ";
    $levelName =~ s/\.[^\.]*?$//;
    if ( $curLevel =~ /^$levelName$/ ) { # Treat special case...
      $levelName = "";
    }
    $line = $';
    print MSG "'$levelName'\n";
  }
  return ($line,$levelName);

}

#______________________________________________________________________
# Count number of braces
# Opening adds one, closing removes one
sub countBraces {

  my $string = shift;
  my $nBraces = 0;
  my $char = "";

  while ( length($string)>0 ) {
    $char = chop($string);
    ++$nBraces if ( $char =~ /\{/ );
    --$nBraces if ( $char =~ /\}/ );
  }

  return $nBraces;

}


#______________________________________________________________________
# Subroutine to nicely dump the replace statements
# Tries to align comments
sub dumpReplace {
  my $prefix = shift; # Level name
  my $name   = shift; # Parameter name
  my $string = shift; # Value, including possible comment

  if ( $string =~ /(#|\/\/)\s*/ ) {
    my $value = $`;
    my $comment = $';
    $value =~ s/\s+$//g; # Remove trailing spaces
    # Alignment: add necessary spaces
    while ( length($prefix.$name." = ".$value) < $alignment ) { $value .= " "; }
    $string = $value." # ".$comment;
  }
  print "replace $prefix.$name = $string";
}
Revision:	1.1.1.1 (vendor branch)
Committed:	Tue Oct 20 17:15:14 2009 UTC (15 years, 6 months ago) by dgele
Content type:	application/x-perl
Branch:	ANA
CVS Tags:	start
Changes since 1.1:	+0 -0 lines
Log Message:	version CMSSW_2_2_10
#	User	Rev	Content
1	dgele	1.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 ( /\sinclude\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			}