5 # This is a script which can try to fix a formatting problem which could have
6 # been introduced by perltidy if certain versions of perltidy were run with the
7 # particular parameter combination -scbb -csc.
9 # The problem occurred in versions 20200110, 20200619, and 20200822 when the
10 # parameter combination -scbb -csc was used.
12 # This seems to be a fairly rare combination but could certainly happen. The
13 # problem was found during random testing of perltidy. It is fixed in the latest
16 # What happened is that two consecutive lines which had closing braces
17 # and side comments generated by the -csc parameter were missing a
18 # separating newline. So for example the following two lines:
21 # } ## end while (<STYLES>...
23 # were actually combined like this:
24 # } ## end if (...} ## end while (<STYLES>...
26 # If this happened to your script you could insert the line breaks by hand. An
27 # alternative is to run this script on the bad file. It runs as a filter and
28 # looks for the special patterns and inserts the missing newlines.
30 # This will probably work on a script which has just been run once with these
31 # parameters. But it will probably not work if the script has been reformatted
32 # with these parameters multiple times, or if iterations have been done.
33 # Unfortunately in that case key comment information will have been lost.
35 # The script can be modified if a special side comment prefix other than '##
39 # fix-scbb-csc-bug.pl <infile >ofile
41 # This is what we are looking for: a closing brace followed by csc prefix
42 my $pattern = '} ## end';
44 while ( my $line = <> ) {
47 if ( $line && $line =~ /$pattern/ ) {
49 my $leading_spaces = "";
51 if ( $line =~ /^(\s*)(.*)$/ ) { $leading_spaces = $1; $text = $2 }
52 my @parts = split /$pattern/, $text;
54 # just print the line for an exact match
55 if ( !@parts ) { print $line, "\n"; next }
60 while ( @parts > 1 ) {
62 # Start at the end and work back, saving lines in @lines
63 # If we see something with trailing braces, like } ## end }}
64 # then we will break before the trailing braces.
65 my $part = pop(@parts);
69 # it's easiest to reverse the string, match multiple braces, and
71 my $rev = reverse $part;
72 if ( $rev =~ /^([\}\s]+)(.*)$/ ) {
76 push @lines, $pattern . $csc;
77 push @lines, $braces if ($braces);
80 # The first section needs leading whitespace
82 my $part = pop(@parts);
84 my $line = $leading_spaces . $part;
89 if ($braces) { $i = -2 }
90 $lines[$i] = $leading_spaces . $lines[$i];
93 while ( my $line = shift @lines ) {