examples/fix-scbb-csc-bug.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use warnings;
   4
   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.
   8
   9 # The problem occurred in versions 20200110, 20200619, and 20200822 when the
  10 # parameter combination -scbb -csc was used.
  11
  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
  14 # version.
  15
  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:
  19
  20 #   } ## end if (...
  21 # } ## end while (<STYLES>...
  22
  23 # were actually combined like this:
  24 #   } ## end if (...} ## end while (<STYLES>...
  25
  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.
  29
  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.
  34
  35 # The script can be modified if a special side comment prefix other than '##
  36 # end' was used.
  37
  38 # usage:
  39 #   fix-scbb-csc-bug.pl <infile >ofile
  40
  41 # This is what we are looking for: a closing brace followed by csc prefix
  42 my $pattern = '} ## end';
  43
  44 while ( my $line = <> ) {
  45     chomp $line;
  46
  47     if ( $line && $line =~ /$pattern/ ) {
  48
  49         my $leading_spaces = "";
  50         my $text;
  51         if ( $line =~ /^(\s*)(.*)$/ ) { $leading_spaces = $1; $text = $2 }
  52         my @parts = split /$pattern/, $text;
  53
  54         # just print the line for an exact match
  55         if ( !@parts ) { print $line, "\n"; next }
  56
  57         my $csc     = "";
  58         my $braces  = "";
  59         my @lines;
  60         while ( @parts > 1 ) {
  61
  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);
  66             $csc    = $part;
  67             $braces = "";
  68
  69             # it's easiest to reverse the string, match multiple braces, and
  70             # reverse again
  71             my $rev = reverse $part;
  72             if ( $rev =~ /^([\}\s]+)(.*)$/ ) {
  73                 $csc    = reverse $2;
  74                 $braces = reverse $1;
  75             }
  76             push @lines, $pattern . $csc;
  77             push @lines, $braces if ($braces);
  78         }
  79
  80         # The first section needs leading whitespace
  81         if (@parts) {
  82             my $part = pop(@parts);
  83             if ($part) {
  84                 my $line = $leading_spaces . $part;
  85                 push @lines, $line;
  86             }
  87             elsif (@lines) {
  88                 my $i = -1;
  89                 if ($braces) { $i = -2 }
  90                 $lines[$i] = $leading_spaces . $lines[$i];
  91             }
  92         }
  93         while ( my $line = shift @lines ) {
  94             print $line . "\n";
  95         }
  96         next;
  97     }
  98     print $line. "\n";
  99 }