scripts/cleanpatch

   1 #!/usr/bin/env perl
   2 #
   3 # Clean a patch file -- or directory of patch files -- of stealth whitespace.
   4 # WARNING: this can be a highly destructive operation.  Use with caution.
   5 #
   6
   7 use warnings;
   8 use bytes;
   9 use File::Basename;
  10
  11 # Default options
  12 $max_width = 79;
  13
  14 # Clean up space-tab sequences, either by removing spaces or
  15 # replacing them with tabs.
  16 sub clean_space_tabs($)
  17 {
  18     no bytes;                   # Tab alignment depends on characters
  19
  20     my($li) = @_;
  21     my($lo) = '';
  22     my $pos = 0;
  23     my $nsp = 0;
  24     my($i, $c);
  25
  26     for ($i = 0; $i < length($li); $i++) {
  27         $c = substr($li, $i, 1);
  28         if ($c eq "\t") {
  29             my $npos = ($pos+$nsp+8) & ~7;
  30             my $ntab = ($npos >> 3) - ($pos >> 3);
  31             $lo .= "\t" x $ntab;
  32             $pos = $npos;
  33             $nsp = 0;
  34         } elsif ($c eq "\n" || $c eq "\r") {
  35             $lo .= " " x $nsp;
  36             $pos += $nsp;
  37             $nsp = 0;
  38             $lo .= $c;
  39             $pos = 0;
  40         } elsif ($c eq " ") {
  41             $nsp++;
  42         } else {
  43             $lo .= " " x $nsp;
  44             $pos += $nsp;
  45             $nsp = 0;
  46             $lo .= $c;
  47             $pos++;
  48         }
  49     }
  50     $lo .= " " x $nsp;
  51     return $lo;
  52 }
  53
  54 # Compute the visual width of a string
  55 sub strwidth($) {
  56     no bytes;                   # Tab alignment depends on characters
  57
  58     my($li) = @_;
  59     my($c, $i);
  60     my $pos = 0;
  61     my $mlen = 0;
  62
  63     for ($i = 0; $i < length($li); $i++) {
  64         $c = substr($li,$i,1);
  65         if ($c eq "\t") {
  66             $pos = ($pos+8) & ~7;
  67         } elsif ($c eq "\n") {
  68             $mlen = $pos if ($pos > $mlen);
  69             $pos = 0;
  70         } else {
  71             $pos++;
  72         }
  73     }
  74
  75     $mlen = $pos if ($pos > $mlen);
  76     return $mlen;
  77 }
  78
  79 $name = basename($0);
  80
  81 @files = ();
  82
  83 while (defined($a = shift(@ARGV))) {
  84     if ($a =~ /^-/) {
  85         if ($a eq '-width' || $a eq '-w') {
  86             $max_width = shift(@ARGV)+0;
  87         } else {
  88             print STDERR "Usage: $name [-width #] files...\n";
  89             exit 1;
  90         }
  91     } else {
  92         push(@files, $a);
  93     }
  94 }
  95
  96 foreach $f ( @files ) {
  97     print STDERR "$name: $f\n";
  98
  99     if (! -f $f) {
 100         print STDERR "$f: not a file\n";
 101         next;
 102     }
 103
 104     if (!open(FILE, '+<', $f)) {
 105         print STDERR "$name: Cannot open file: $f: $!\n";
 106         next;
 107     }
 108
 109     binmode FILE;
 110
 111     # First, verify that it is not a binary file; consider any file
 112     # with a zero byte to be a binary file.  Is there any better, or
 113     # additional, heuristic that should be applied?
 114     $is_binary = 0;
 115
 116     while (read(FILE, $data, 65536) > 0) {
 117         if ($data =~ /\0/) {
 118             $is_binary = 1;
 119             last;
 120         }
 121     }
 122
 123     if ($is_binary) {
 124         print STDERR "$name: $f: binary file\n";
 125         next;
 126     }
 127
 128     seek(FILE, 0, 0);
 129
 130     $in_bytes = 0;
 131     $out_bytes = 0;
 132     $lineno = 0;
 133
 134     @lines  = ();
 135
 136     $in_hunk = 0;
 137     $err = 0;
 138
 139     while ( defined($line = <FILE>) ) {
 140         $lineno++;
 141         $in_bytes += length($line);
 142
 143         if (!$in_hunk) {
 144             if ($line =~
 145                 /^\@\@\s+\-([0-9]+),([0-9]+)\s+\+([0-9]+),([0-9]+)\s\@\@/) {
 146                 $minus_lines = $2;
 147                 $plus_lines = $4;
 148                 if ($minus_lines || $plus_lines) {
 149                     $in_hunk = 1;
 150                     @hunk_lines = ($line);
 151                 }
 152             } else {
 153                 push(@lines, $line);
 154                 $out_bytes += length($line);
 155             }
 156         } else {
 157             # We're in a hunk
 158
 159             if ($line =~ /^\+/) {
 160                 $plus_lines--;
 161
 162                 $text = substr($line, 1);
 163                 $text =~ s/[ \t\r]*$//;         # Remove trailing spaces
 164                 $text = clean_space_tabs($text);
 165
 166                 $l_width = strwidth($text);
 167                 if ($max_width && $l_width > $max_width) {
 168                     print STDERR
 169                         "$f:$lineno: adds line exceeds $max_width ",
 170                         "characters ($l_width)\n";
 171                 }
 172
 173                 push(@hunk_lines, '+'.$text);
 174             } elsif ($line =~ /^\-/) {
 175                 $minus_lines--;
 176                 push(@hunk_lines, $line);
 177             } elsif ($line =~ /^ /) {
 178                 $plus_lines--;
 179                 $minus_lines--;
 180                 push(@hunk_lines, $line);
 181             } else {
 182                 print STDERR "$name: $f: malformed patch\n";
 183                 $err = 1;
 184                 last;
 185             }
 186
 187             if ($plus_lines < 0 || $minus_lines < 0) {
 188                 print STDERR "$name: $f: malformed patch\n";
 189                 $err = 1;
 190                 last;
 191             } elsif ($plus_lines == 0 && $minus_lines == 0) {
 192                 # End of a hunk.  Process this hunk.
 193                 my $i;
 194                 my $l;
 195                 my @h = ();
 196                 my $adj = 0;
 197                 my $done = 0;
 198
 199                 for ($i = scalar(@hunk_lines)-1; $i > 0; $i--) {
 200                     $l = $hunk_lines[$i];
 201                     if (!$done && $l eq "+\n") {
 202                         $adj++; # Skip this line
 203                     } elsif ($l =~ /^[ +]/) {
 204                         $done = 1;
 205                         unshift(@h, $l);
 206                     } else {
 207                         unshift(@h, $l);
 208                     }
 209                 }
 210
 211                 $l = $hunk_lines[0];  # Hunk header
 212                 undef @hunk_lines;    # Free memory
 213
 214                 if ($adj) {
 215                     die unless
 216                         ($l =~ /^\@\@\s+\-([0-9]+),([0-9]+)\s+\+([0-9]+),([0-9]+)\s\@\@(.*)$/);
 217                     my $mstart = $1;
 218                     my $mlin = $2;
 219                     my $pstart = $3;
 220                     my $plin = $4;
 221                     my $tail = $5; # doesn't include the final newline
 222
 223                     $l = sprintf("@@ -%d,%d +%d,%d @@%s\n",
 224                                  $mstart, $mlin, $pstart, $plin-$adj,
 225                                  $tail);
 226                 }
 227                 unshift(@h, $l);
 228
 229                 # Transfer to the output array
 230                 foreach $l (@h) {
 231                     $out_bytes += length($l);
 232                     push(@lines, $l);
 233                 }
 234
 235                 $in_hunk = 0;
 236             }
 237         }
 238     }
 239
 240     if ($in_hunk) {
 241         print STDERR "$name: $f: malformed patch\n";
 242         $err = 1;
 243     }
 244
 245     if (!$err) {
 246         if ($in_bytes != $out_bytes) {
 247             # Only write to the file if changed
 248             seek(FILE, 0, 0);
 249             print FILE @lines;
 250
 251             if ( !defined($where = tell(FILE)) ||
 252                  !truncate(FILE, $where) ) {
 253                 die "$name: Failed to truncate modified file: $f: $!\n";
 254             }
 255         }
 256     }
 257
 258     close(FILE);
 259 }