Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quelle  cleanpatch   Sprache: Fortran

 
#!/usr/bin/env perl
# SPDX-License-Identifier: GPL-2.0
#
# Clean a patch file -- or directory of patch files -- of stealth whitespace.
# WARNING: this can be a highly destructive operation.  Use with caution.
#

use warnings;
use bytes;
use File::Basename;

# Default options
$max_width = 79;

# Clean up space-tab sequences, either by removing spaces or
# replacing them with tabs.
sub clean_space_tabs($)
{
    no bytes;   # Tab alignment depends on characters

    my($li) = @_;
    my($lo) = '';
    my $pos = 0;
    my $nsp = 0;
    my($i, $c);

    for ($i = 0; $i < length($li); $i++) {
 $c = substr($li, $i, 1);
 if ($c eq "\t") {
     my $npos = ($pos+$nsp+8) & ~7;
     my $ntab = ($npos >> 3) - ($pos >> 3);
     $lo .= "\t" x $ntab;
     $pos = $npos;
     $nsp = 0;
 } elsif ($c eq "\n" || $c eq "\r") {
     $lo .= " " x $nsp;
     $pos += $nsp;
     $nsp = 0;
     $lo .= $c;
     $pos = 0;
 } elsif ($c eq " ") {
     $nsp++;
 } else {
     $lo .= " " x $nsp;
     $pos += $nsp;
     $nsp = 0;
     $lo .= $c;
     $pos++;
 }
    }
    $lo .= " " x $nsp;
    return $lo;
}

# Compute the visual width of a string
sub strwidth($) {
    no bytes;   # Tab alignment depends on characters

    my($li) = @_;
    my($c, $i);
    my $pos = 0;
    my $mlen = 0;

    for ($i = 0; $i < length($li); $i++) {
 $c = substr($li,$i,1);
 if ($c eq "\t") {
     $pos = ($pos+8) & ~7;
 } elsif ($c eq "\n") {
     $mlen = $pos if ($pos > $mlen);
     $pos = 0;
 } else {
     $pos++;
 }
    }

    $mlen = $pos if ($pos > $mlen);
    return $mlen;
}

$name = basename($0);

@files = ();

while (defined($a = shift(@ARGV))) {
    if ($a =~ /^-/) {
 if ($a eq '-width' || $a eq '-w') {
     $max_width = shift(@ARGV)+0;
 } else {
     print STDERR "Usage: $name [-width #] files...\n";
     exit 1;
 }
    } else {
 push(@files, $a);
    }
}

foreach $f ( @files ) {
    print STDERR "$name: $f\n";

    if (! -f $f) {
 print STDERR "$f: not a file\n";
 next;
    }

    if (!open(FILE, '+<', $f)) {
 print STDERR "$name: Cannot open file: $f: $!\n";
 next;
    }

    binmode FILE;

    # First, verify that it is not a binary file; consider any file
    # with a zero byte to be a binary file.  Is there any better, or
    # additional, heuristic that should be applied?
    $is_binary = 0;

    while (read(FILE, $data, 65536) > 0) {
 if ($data =~ /\0/) {
     $is_binary = 1;
     last;
 }
    }

    if ($is_binary) {
 print STDERR "$name: $f: binary file\n";
 next;
    }

    seek(FILE, 0, 0);

    $in_bytes = 0;
    $out_bytes = 0;
    $lineno = 0;

    @lines  = ();

    $in_hunk = 0;
    $err = 0;

    while ( defined($line = <FILE>) ) {
 $lineno++;
 $in_bytes += length($line);

 if (!$in_hunk) {
     if ($line =~
  /^\@\@\s+\-([0-9]+),([0-9]+)\s+\+([0-9]+),([0-9]+)\s\@\@/) {
  $minus_lines = $2;
  $plus_lines = $4;
  if ($minus_lines || $plus_lines) {
      $in_hunk = 1;
      @hunk_lines = ($line);
  }
     } else {
  push(@lines, $line);
  $out_bytes += length($line);
     }
 } else {
     # We're in a hunk

     if ($line =~ /^\+/) {
  $plus_lines--;

  $text = substr($line, 1);
  $text =~ s/[ \t\r]*$//;  # Remove trailing spaces
  $text = clean_space_tabs($text);

  $l_width = strwidth($text);
  if ($max_width && $l_width > $max_width) {
      print STDERR
   "$f:$lineno: adds line exceeds $max_width ",
   "characters ($l_width)\n";
  }

  push(@hunk_lines, '+'.$text);
     } elsif ($line =~ /^\-/) {
  $minus_lines--;
  push(@hunk_lines, $line);
     } elsif ($line =~ /^ /) {
  $plus_lines--;
  $minus_lines--;
  push(@hunk_lines, $line);
     } else {
  print STDERR "$name: $f: malformed patch\n";
  $err = 1;
  last;
     }

     if ($plus_lines < 0 || $minus_lines < 0) {
  print STDERR "$name: $f: malformed patch\n";
  $err = 1;
  last;
     } elsif ($plus_lines == 0 && $minus_lines == 0) {
  # End of a hunk.  Process this hunk.
  my $i;
  my $l;
  my @h = ();
  my $adj = 0;
  my $done = 0;

  for ($i = scalar(@hunk_lines)-1; $i > 0; $i--) {
      $l = $hunk_lines[$i];
      if (!$done && $l eq "+\n") {
   $adj++; # Skip this line
      } elsif ($l =~ /^[ +]/) {
   $done = 1;
   unshift(@h, $l);
      } else {
   unshift(@h, $l);
      }
  }

  $l = $hunk_lines[0];  # Hunk header
  undef @hunk_lines;    # Free memory

  if ($adj) {
      die unless
   ($l =~ /^\@\@\s+\-([0-9]+),([0-9]+)\s+\+([0-9]+),([0-9]+)\s\@\@(.*)$/);
      my $mstart = $1;
      my $mlin = $2;
      my $pstart = $3;
      my $plin = $4;
      my $tail = $5; # doesn't include the final newline

      $l = sprintf("@@ -%d,%d +%d,%d @@%s\n",
     $mstart, $mlin, $pstart, $plin-$adj,
     $tail);
  }
  unshift(@h, $l);

  # Transfer to the output array
  foreach $l (@h) {
      $out_bytes += length($l);
      push(@lines, $l);
  }

  $in_hunk = 0;
     }
 }
    }

    if ($in_hunk) {
 print STDERR "$name: $f: malformed patch\n";
 $err = 1;
    }

    if (!$err) {
 if ($in_bytes != $out_bytes) {
     # Only write to the file if changed
     seek(FILE, 0, 0);
     print FILE @lines;

     if ( !defined($where = tell(FILE)) ||
   !truncate(FILE, $where) ) {
  die "$name: Failed to truncate modified file: $f: $!\n";
     }
 }
    }

    close(FILE);
}

¤ Dauer der Verarbeitung: 0.28 Sekunden  (vorverarbeitet)  ¤

*© Formatika GbR, Deutschland






Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.






                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge