bin/patdiff

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patdiff.SH 1 2006-08-24 12:32:52Z rmanfredi $
   6 #
   7 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
   8 #
   9 #  You may redistribute only under the terms of the Artistic Licence,
  10 #  as specified in the README file that comes with the distribution.
  11 #  You may reuse parts of this distribution only within the terms of
  12 #  that same Artistic Licence; a copy of which may be found at the root
  13 #  of the source tree for dist 4.0.
  14 #
  15 # Original Author: Larry Wall <lwall@netlabs.com>
  16 #
  17 # $Log: patdiff.SH,v $
  18 # Revision 3.0.1.2  1994/01/24  14:30:36  ram
  19 # patch16: now prefix error messages with program's name
  20 # patch16: added ~/.dist_profile awareness
  21 #
  22 # Revision 3.0.1.1  1993/08/19  06:42:35  ram
  23 # patch1: leading config.sh searching was not aborting properly
  24 #
  25 # Revision 3.0  1993/08/18  12:10:43  ram
  26 # Baseline for dist 3.0 netwide release.
  27 #
  28
  29 $version = '3.5';
  30 $patchlevel = '0';
  31
  32 $RCSEXT = ',v' unless $RCSEXT;
  33 $TOPDIR = '';                   # We are at top-level directory
  34
  35 $progname = &profile;   # Read ~/.dist_profile
  36 require 'getopts.pl';
  37 &usage unless $#ARGV >= 0;
  38 &usage unless &Getopts("ahnV");
  39
  40 if ($opt_V) {
  41         print STDERR "$progname $version PL$patchlevel\n";
  42         exit 0;
  43 } elsif ($opt_h) {
  44         &usage;
  45 }
  46
  47 &readpackage;
  48 &copyright'init($copyright) if -f $copyright;
  49
  50 system 'mkdir', 'bugs' unless -d 'bugs';
  51
  52 if (-f 'patchlevel.h') {
  53         open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n";
  54         while (<PL>) {
  55                 $bnum = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/;
  56         }
  57         die "$progname: malformed patchlevel.h file.\n" if $bnum eq '';
  58         ++$bnum;
  59 } else {
  60         $bnum=1;
  61 }
  62
  63 if ($opt_a) {
  64         open(MANI,"MANIFEST.new") || die "$progname: can't read MANIFEST.new: $!\n";
  65         @ARGV = ();
  66         while (<MANI>) {
  67                 chop;
  68                 ($_) = split(' ');
  69                 next if -d;
  70                 push(@ARGV,$_);
  71         }
  72         close MANI;
  73 }
  74
  75 foreach $file (@ARGV) {
  76         next if ($file =~ /^patchlevel.h$/);            # Skip patchlevel.h
  77         if (! -f $file) {
  78                 print "$progname: $file not found.\n";
  79                 next;
  80         }
  81         $files = &rcsargs($file);
  82         @files = split(' ',$files);
  83         $new='';
  84         $revs=0;
  85         $rlog = `rlog -rlastpat- $files 2>&1`;
  86         ($lastpat) = ($rlog =~ /lastpat: ([\d.]+)/);
  87         ($revs) = ($rlog =~ /selected revisions: (\d+)/);
  88         if (!$revs) {
  89                 print "$progname: no cil has been done on $file.\n" ;;
  90         } elsif ($revs == 1) {
  91                 ($base) = ($rlog =~ /.*\nrevision\s+(\S+)/);
  92                 ($a,$b,$c,$d) = split(/\./,$base);
  93                 if ($d ne '') {
  94                         if (!$opt_n) {
  95                                 print
  96         "$progname: no changes in $file since last patch.  (Did you cil it?)\n";
  97                                 next;           # Skip file with no changes
  98                         } else {
  99                                 $new='foo';
 100                         }
 101                 } else {
 102                         $revs=0;
 103                         $rlog = `rlog -r$revbranch- $files 2>&1`;
 104                         ($revs) = ($rlog =~ /selected revisions: (\d+)/);
 105                         if (!$revs) {
 106                                 print
 107         "$progname: no changes in $file since base version.  (Did you cil it?)\n";
 108                                 next;           # Skip file with no changes
 109                         } else {
 110                                 ($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
 111                         }
 112                 }
 113         } else {
 114                 ($new) = ($rlog =~ /\nrevision\s*(\d+\.\d+\.\d+\.\d+)/);
 115         }
 116         if ($new ne '') {
 117                 ($fname = $file) =~ s|.*/||;
 118                 $fname = substr($fname, 0, 11);         # For filsystems with short names
 119                 open(PATCH,">>bugs/$fname.$bnum") || die "Can't make patch";
 120                 print PATCH "\nIndex: $file\n";
 121                 open(CO,"co -p -rlastpat $files 2>/dev/null |");
 122                 while (<CO>) {
 123                         if (/\$Header/ || /\$Id/) {
 124                                 print PATCH "Prereq: $lastpat\n";
 125                                 last;
 126                         }
 127                 }
 128                 close CO;
 129                 if (!$opt_n) {
 130                         if ($mydiff eq '') {
 131                                 open(DIFF,"rcsdiff -c -rlastpat -r$new $files |") ||
 132                                 die "$progname: can't fork rcsdiff: $!\n";
 133                                 while (<DIFF>) {
 134                                         if ($. == 1) {s|\*\*\* \S+      |*** $file.old  |;}
 135                                         if ($. == 2) {s|--- \S+ |--- $file      |;}
 136                                         s|Lock[e]r:.*\$|\$|;    # Use [e] to make it safe on itself
 137                                         print PATCH;
 138                                 }
 139                                 close DIFF;
 140                                 system 'rcs', "-Nlastpat:$new", @files;
 141                         } else {
 142                                 &copyright'expand("co -p -rlastpat $file", "/tmp/pdo$$");
 143                                 &copyright'expand("co -p -r$new $file", "/tmp/pdn$$");
 144                                 open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ |") ||
 145                                 die "Can't run $mydiff";
 146                                 while (<DIFF>) {                        # Contextual or unified diff
 147                                         if ($. == 1) {
 148                                                 s|\*\*\* \S+    |*** $file.old  | ||
 149                                                 s|--- \S+       |--- $file.old  |;
 150                                         }
 151                                         if ($. == 2) {
 152                                                 s|--- \S+       |--- $file      | ||
 153                                                 s|\+\+\+ \S+    |+++ $file      |;
 154                                         }
 155                                         s|Lock[e]r:.*\$|\$|;    # Remove locker mark
 156                                         print PATCH;
 157                                 }
 158                                 close DIFF;
 159                                 system 'rcs', "-Nlastpat:$new", @files;
 160                                 unlink "/tmp/pdn$$", "/tmp/pdo$$";
 161                         }
 162                 } else {
 163                         if ($mydiff eq '') {
 164                                 open(DIFF,"rcsdiff -c -rlastpat $files |") ||
 165                                 die "Can't run rcsdiff";
 166                                 while (<DIFF>) {
 167                                         if ($. == 1) {s|\*\*\* \S+      |*** $file.old  |;}
 168                                         if ($. == 2) {s|--- \S+ |--- $file      |;}
 169                                         s|Lock[e]r:.*\$|\$|;    # Remove locker mark
 170                                         print PATCH;
 171                                 }
 172                                 close DIFF;
 173                         } else {
 174                                 system "co -p -rlastpat $files >/tmp/pdo$$";
 175                                 system "cp $file /tmp/pdn$$";
 176                                 open(DIFF, "$mydiff /tmp/pdo$$ /tmp/pdn$$ |") ||
 177                                 die "$progname: can't fork $mydiff: $!\n";
 178                                 while (<DIFF>) {
 179                                         # Contextual or unified diff
 180                                         if ($. == 1) {
 181                                                 s|\*\*\* \S+    |*** $file.old  |;
 182                                                 s|--- \S+       |--- $file.old  |;
 183                                         }
 184                                         if ($. == 2) {
 185                                                 s|--- \S+       |--- $file      |;
 186                                                 s|\+\+\+ \S+    |+++ $file      |;
 187                                         }
 188                                         s|Lock[e]r:.*\$|\$|;    # Remove locker mark
 189                                         print PATCH;
 190                                 }
 191                                 close DIFF;
 192                                 unlink "/tmp/pdn$$", "/tmp/pdo$$";
 193                         }
 194                 }
 195         }
 196 }
 197
 198 sub usage {
 199         print STDERR <<EOM;
 200 Usage: $progname [-ahnV] [filelist]
 201   -a : all the files in MANIFEST.new
 202   -h : print this message and exit
 203   -n : non update mode
 204   -V : print version number and exit
 205 EOM
 206         exit 1;
 207 }
 208
 209 sub readpackage {
 210         if (! -f '.package') {
 211                 if (
 212                         -f '../.package' ||
 213                         -f '../../.package' ||
 214                         -f '../../../.package' ||
 215                         -f '../../../../.package'
 216                 ) {
 217                         die "Run in top level directory only.\n";
 218                 } else {
 219                         die "No .package file!  Run packinit.\n";
 220                 }
 221         }
 222         open(PACKAGE,'.package');
 223         while (<PACKAGE>) {
 224                 next if /^:/;
 225                 next if /^#/;
 226                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 227                         $val = "\"$val\"" unless $val =~ /^['"]/;
 228                         eval "\$$var = $val;";
 229                 }
 230         }
 231         close PACKAGE;
 232 }
 233
 234 sub rcsargs {
 235         local($result) = '';
 236         local($_);
 237         while ($_ = shift(@_)) {
 238                 if ($_ =~ /^-/) {
 239                         $result .= $_ . ' ';
 240                 } elsif ($#_ >= 0 && do equiv($_,$_[0])) {
 241                         $result .= $_ . ' ' . $_[0] . ' ';
 242                         shift(@_);
 243                 } else {
 244                         $result .= $_ . ' ' . do other($_) . ' ';
 245                 }
 246         }
 247         $result;
 248 }
 249
 250 sub equiv {
 251         local($s1, $s2) = @_;
 252         $s1 =~ s|.*/||;
 253         $s2 =~ s|.*/||;
 254         if ($s1 eq $s2) {
 255                 0;
 256         } elsif ($s1 =~ s/$RCSEXT$// || $s2 =~ s/$RCSEXT$//) {
 257                 $s1 eq $s2;
 258         } else {
 259                 0;
 260         }
 261 }
 262
 263 sub other {
 264         local($s1) = @_;
 265         ($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m|(.*/)(.*)|);
 266         $dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
 267         local($wasrcs) = ($file =~ s/$RCSEXT$//);
 268         if ($wasrcs) {
 269                 `mkdir $dir` unless -d $dir;
 270                 $dir =~ s|RCS/||;
 271         } else {
 272                 $dir .= 'RCS/';
 273                 `mkdir $dir` unless -d $dir;
 274                 $file .= $RCSEXT;
 275         }
 276         "$dir$file";
 277 }
 278
 279 package copyright;
 280
 281 # Read in copyright file
 282 sub init {
 283         local($file) = @_;              # Copyright file
 284         undef @copyright;
 285         open(COPYRIGHT, $file) || die "Can't open $file: $!\n";
 286         chop(@copyright = <COPYRIGHT>);
 287         close COPYRIGHT;
 288 }
 289
 290 # Reset the automaton for a new file.
 291 sub reset {
 292         $copyright_seen = @copyright ? 0 : 1;
 293         $marker_seen = 0;
 294 }
 295
 296 # Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
 297 # symbol may be preceded by some random comment. A leader can be defined and
 298 # will be pre-pended to all the input lines.
 299 sub filter {
 300         local($line, $leader) = @_;             # Leader is optional
 301         return $leader . $line if $copyright_seen || $marker_seen;
 302         $marker_seen = 1 if $line =~ /\$Log[:\$]/;
 303         $copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
 304         return $leader . $line unless $copyright_seen;
 305         local($comment, $trailer) = $line =~ /^(.*)\@COPYRIGHT\@\s*(.*)/;
 306         $comment = $leader . $comment;
 307         $comment . join("\n$comment", @copyright) . "\n";
 308 }
 309
 310 # Filter output of $cmd redirected into $file by expanding copyright, if any.
 311 sub expand {
 312         local($cmd, $file) = @_;
 313         if (@copyright) {
 314                 open(CMD,"$cmd|") || die "Can't start '$cmd': $!\n";
 315                 open(OUT, ">$file") || die "Can't create $file: $!\n";
 316                 &reset;
 317                 local($_);
 318                 while (<CMD>) {
 319                         print OUT &filter($_);
 320                 }
 321                 close OUT;
 322                 close CMD;
 323         } else {
 324                 system "$cmd > $file";
 325                 die "Command '$cmd' failed!" if $?;
 326         }
 327 }
 328
 329 package main;
 330
 331 # Perform ~name expansion ala ksh...
 332 # (banish csh from your vocabulary ;-)
 333 sub tilda_expand {
 334         local($path) = @_;
 335         return $path unless $path =~ /^~/;
 336         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 337         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 338         $path;
 339 }
 340
 341 # Set up profile components into %Profile, add any profile-supplied options
 342 # into @ARGV and return the command invocation name.
 343 sub profile {
 344         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 345         local($me) = $0;                # Command name
 346         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 347         return $me unless -s $profile;
 348         local(*PROFILE);                # Local file descriptor
 349         local($options) = '';   # Options we get back from profile
 350         unless (open(PROFILE, $profile)) {
 351                 warn "$me: cannot open $profile: $!\n";
 352                 return;
 353         }
 354         local($_);
 355         local($component);
 356         while (<PROFILE>) {
 357                 next if /^\s*#/;        # Skip comments
 358                 next unless /^$me/o;
 359                 if (s/^$me://o) {       # progname: options
 360                         chop;
 361                         $options .= $_; # Merge options if more than one line
 362                 }
 363                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 364                         $component = $1;
 365                         chop;
 366                         s/^\s+//;               # Trim leading and trailing spaces
 367                         s/\s+$//;
 368                         $Profile{$component} = $_;
 369                 }
 370         }
 371         close PROFILE;
 372         return unless $options;
 373         require 'shellwords.pl';
 374         local(@opts);
 375         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 376         unshift(@ARGV, @opts);
 377         return $me;                             # Return our invocation name
 378 }
 379