New upstream version 20210717

[perltidy.git] / examples / fix-scbb-csc-bug.pl

diff --git a/examples/fix-scbb-csc-bug.pl b/examples/fix-scbb-csc-bug.pl
new file mode 100755 (executable)
index 0000000..dd9c380
--- /dev/null
+++ b/examples/fix-scbb-csc-bug.pl
@@ -0,0 +1,99 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+# This is a script which can try to fix a formatting problem which could have
+# been introduced by perltidy if certain versions of perltidy were run with the
+# particular parameter combination -scbb -csc.  
+
+# The problem occurred in versions 20200110, 20200619, and 20200822 when the
+# parameter combination -scbb -csc was used.  
+
+# This seems to be a fairly rare combination but could certainly happen.  The
+# problem was found during random testing of perltidy.  It is fixed in the latest
+# version.
+
+# What happened is that two consecutive lines which had closing braces
+# and side comments generated by the -csc parameter were missing a
+# separating newline.  So for example the following two lines:
+
+#   } ## end if (...
+# } ## end while (<STYLES>...
+
+# were actually combined like this:
+#   } ## end if (...} ## end while (<STYLES>...
+
+# If this happened to your script you could insert the line breaks by hand.  An
+# alternative is to run this script on the bad file. It runs as a filter and
+# looks for the special patterns and inserts the missing newlines.
+
+# This will probably work on a script which has just been run once with these
+# parameters. But it will probably not work if the script has been reformatted
+# with these parameters multiple times, or if iterations have been done.
+# Unfortunately in that case key comment information will have been lost.
+
+# The script can be modified if a special side comment prefix other than '##
+# end' was used.
+
+# usage:
+#   fix-scbb-csc-bug.pl <infile >ofile
+
+# This is what we are looking for: a closing brace followed by csc prefix
+my $pattern = '} ## end';
+
+while ( my $line = <> ) {
+    chomp $line;
+
+    if ( $line && $line =~ /$pattern/ ) {
+
+        my $leading_spaces = "";
+        my $text;
+        if ( $line =~ /^(\s*)(.*)$/ ) { $leading_spaces = $1; $text = $2 }
+        my @parts = split /$pattern/, $text;
+
+        # just print the line for an exact match
+        if ( !@parts ) { print $line, "\n"; next }
+
+        my $csc     = "";
+        my $braces  = "";
+        my @lines;
+        while ( @parts > 1 ) {
+
+            # Start at the end and work back, saving lines in @lines
+            # If we see something with trailing braces, like } ## end }}
+            # then we will break before the trailing braces.
+            my $part = pop(@parts);
+            $csc    = $part;
+            $braces = "";
+
+            # it's easiest to reverse the string, match multiple braces, and
+            # reverse again
+            my $rev = reverse $part;
+            if ( $rev =~ /^([\}\s]+)(.*)$/ ) {
+                $csc    = reverse $2;
+                $braces = reverse $1;
+            }
+            push @lines, $pattern . $csc;
+            push @lines, $braces if ($braces);
+        }
+
+        # The first section needs leading whitespace
+        if (@parts) {
+            my $part = pop(@parts);
+            if ($part) {
+                my $line = $leading_spaces . $part;
+                push @lines, $line;
+            }
+            elsif (@lines) {
+                my $i = -1;
+                if ($braces) { $i = -2 }
+                $lines[$i] = $leading_spaces . $lines[$i];
+            }
+        }
+        while ( my $line = shift @lines ) {
+            print $line . "\n";
+        }
+        next;
+    }
+    print $line. "\n";
+}