bin/patname

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patname.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 # $Log: patname.SH,v $
  16 # Revision 3.0.1.2  1994/01/24  14:31:02  ram
  17 # patch16: now prefix error messages with program's name
  18 # patch16: added ~/.dist_profile awareness
  19 #
  20 # Revision 3.0.1.1  1993/08/19  06:42:40  ram
  21 # patch1: leading config.sh searching was not aborting properly
  22 #
  23 # Revision 3.0  1993/08/18  12:10:46  ram
  24 # Baseline for dist 3.0 netwide release.
  25 #
  26
  27 $version = '3.5';
  28 $patchlevel = '0';
  29
  30 $progname = &profile;                   # Read ~/.dist_profile
  31 require 'getopts.pl';
  32 &usage unless $#ARGV >= 0;
  33 &usage() unless &Getopts("ahnmv:V");
  34
  35 if ($opt_V) {
  36         print STDERR "$progname $version PL$patchlevel\n";
  37         exit 0;
  38 } elsif ($opt_h) {
  39         &usage;
  40 }
  41
  42 $RCSEXT = ',v' unless $RCSEXT;
  43 $ENV{'DIST'} = '/dev/null';     # Disable ~/.dist_profile
  44
  45 chop($pwd = `pwd`) unless -f '.package';
  46 until (-f '.package') {
  47         die "$progname: no .package file!  Run packinit.\n" unless $pwd;
  48         chdir '..' || die "$progname: can't cd ..: $!\n";
  49         $pwd =~ s|(.*)/(.*)|$1|;
  50         $prefix = $2 . '/' . $prefix;
  51 }
  52 if ($prefix) {
  53         for (@ARGV) {
  54                 s/^/$prefix/ unless m|^[-/]|;
  55         }
  56 }
  57
  58 # We now are at the top level
  59
  60 &readpackage;
  61
  62 unless ($opt_v) {
  63         print STDERR "$progname: version number must be specified using -v.\n";
  64         &usage;
  65 }
  66
  67 if ($opt_n) {
  68         &newer;                         # Look for files newer than patchlevel.h
  69 } elsif ($opt_a) {
  70         open(MANI,"MANIFEST.new") || die "$progname: can't read MANIFEST.new: $!\n";
  71         @ARGV = ();
  72         while (<MANI>) {
  73                 s|^\./||;
  74                 next if m|^patchlevel.h|;               # This file is built by hand
  75                 chop;
  76                 ($_) = split(' ');
  77                 next if -d;
  78                 push(@ARGV,$_);
  79         }
  80         close MANI;
  81 } elsif ($opt_m) {
  82         open(MODS,"bugs/.mods$bnum") || die "$progname: no modification found.\n";
  83         @ARGV = ();
  84         while (<MODS>) {
  85                 next if m|^patchlevel.h$|;              # This file is built by hand
  86                 chop;
  87                 ($_) = split(' ');
  88                 push(@ARGV,$_);
  89         }
  90         close MODS;
  91 }
  92
  93 # Now loop over each file specified, doing a 'rcsfreeze'
  94 foreach $file (@ARGV) {
  95         $files = &rcsargs($file);
  96         @files = split(' ', $files);
  97         $rlog = `rlog -rlastpat- $files 2>&1`;
  98         ($revs) = ($rlog =~ /selected revisions: (\d+)/);
  99         if (!$revs) {
 100                 print "$progname: $file has never been checked in--checking in...\n";
 101                 system 'perl', '-S', 'patcil', '-p', $file;
 102                 $revs = 2;              # At least null trunk + new fresh revision
 103         }
 104         # Look whether there is a branch
 105         if ($revs == 1) {
 106                 $rlog = `rlog -r$revbranch $files 2>&1`;
 107                 ($revs) = ($rlog =~ /selected revisions: (\d+)/);
 108                 $revs++;        # add the base revision
 109         }
 110         # If working file exists, make sure latest version was checked in
 111         if (-f $file) {
 112                 if ($revs == 1) {
 113                         $delta = `rcsdiff -r$baserev $files 2>/dev/null`;
 114                 } else {
 115                         $delta = `rcsdiff -r$revbranch $files 2>/dev/null`;
 116                 }
 117                 if ($delta ne '') {
 118                         # File changed; check it in.
 119                         system 'perl', '-S', 'patcil', '-p', $file;
 120                         if ($revs > 1) {
 121                                 # Have to re-run rlog after a new ci
 122                                 $rlog = `rlog -r$revbranch $files 2>&1`;
 123                         }
 124                 }
 125         }
 126         # Now assign symbolic revision number
 127         if ($revs == 1) {
 128                 system 'rcs', "-N$opt_v:$baserev", @files;
 129         } else {
 130                 ($lastrev) = ($rlog =~ /revision $revbranch\.(\d+)/);
 131                 system 'rcs', "-N$opt_v:$revbranch.$lastrev", @files;
 132         }
 133 }
 134
 135 sub usage {
 136         print STDERR <<EOM;
 137 Usage: $progname [-ahnmV] -v version [filelist]
 138   -a : all the files in MANIFEST.new
 139   -h : print this message and exit
 140   -n : all the files newer than patchlevel.h
 141   -m : all the modified files (which have been patciled)
 142   -v : set version number (mandatory)
 143   -V : print version number and exit
 144 EOM
 145         exit 1;
 146 }
 147
 148 sub newer {
 149         open(FIND, "find . -type f -newer patchlevel.h -print | sort |") ||
 150         die "Can't run find.\n";
 151         open(NEWER,">.newer") || die "Can't create .newer.\n";
 152         open(MANI,"MANIFEST.new");
 153         while (<MANI>) {
 154                 ($name,$foo) = split;
 155                 $mani{$name} = 1;
 156         }
 157         close MANI;
 158         while (<FIND>) {
 159         s|^\./||;
 160         chop;
 161         next if m|^MANIFEST|;
 162         next if m|^PACKLIST$|;
 163         if (!$mani{$_}) {
 164                 next if m|^MANIFEST.new$|;
 165                 next if m|^Changes$|;
 166                 next if m|^Wanted$|;
 167                 next if m|^.package$|;
 168                 next if m|^bugs|;
 169                 next if m|^users$|;
 170                 next if m|^UU/|;
 171                 next if m|^RCS/|;
 172                 next if m|/RCS/|;
 173                 next if m|^config.sh$|;
 174                 next if m|/config.sh$|;
 175                 next if m|^make.out$|;
 176                 next if m|/make.out$|;
 177                 next if m|^all$|;
 178                 next if m|/all$|;
 179                 next if m|^core$|;
 180                 next if m|/core$|;
 181                 next if m|^toto|;
 182                 next if m|/toto|;
 183                 next if m|^\.|;
 184                 next if m|/\.|;
 185                 next if m|\.o$|;
 186                 next if m|\.old$|;
 187                 next if m|\.orig$|;
 188                 next if m|~$|;
 189                 next if $mani{$_ . ".SH"};
 190                 next if m|(.*)\.c$| && $mani{$1 . ".y"};
 191                 next if m|(.*)\.c$| && $mani{$1 . ".l"};
 192                 next if (-x $_ && !m|^Configure$|);
 193         }
 194         print NEWER $_,"\n";
 195         }
 196         close FIND;
 197         close NEWER;
 198         print "Please remove unwanted files...\n";
 199         sleep(2);
 200         system '${EDITOR-vi} .newer';
 201         die "Aborted.\n" unless -s '.newer' > 1;
 202         @ARGV = split(' ',`cat .newer`);
 203 }
 204
 205 sub readpackage {
 206         if (! -f '.package') {
 207                 if (
 208                         -f '../.package' ||
 209                         -f '../../.package' ||
 210                         -f '../../../.package' ||
 211                         -f '../../../../.package'
 212                 ) {
 213                         die "Run in top level directory only.\n";
 214                 } else {
 215                         die "No .package file!  Run packinit.\n";
 216                 }
 217         }
 218         open(PACKAGE,'.package');
 219         while (<PACKAGE>) {
 220                 next if /^:/;
 221                 next if /^#/;
 222                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 223                         $val = "\"$val\"" unless $val =~ /^['"]/;
 224                         eval "\$$var = $val;";
 225                 }
 226         }
 227         close PACKAGE;
 228 }
 229
 230 sub rcsargs {
 231         local($result) = '';
 232         local($_);
 233         while ($_ = shift(@_)) {
 234                 if ($_ =~ /^-/) {
 235                         $result .= $_ . ' ';
 236                 } elsif ($#_ >= 0 && do equiv($_,$_[0])) {
 237                         $result .= $_ . ' ' . $_[0] . ' ';
 238                         shift(@_);
 239                 } else {
 240                         $result .= $_ . ' ' . do other($_) . ' ';
 241                 }
 242         }
 243         $result;
 244 }
 245
 246 sub equiv {
 247         local($s1, $s2) = @_;
 248         $s1 =~ s|.*/||;
 249         $s2 =~ s|.*/||;
 250         if ($s1 eq $s2) {
 251                 0;
 252         } elsif ($s1 =~ s/$RCSEXT$// || $s2 =~ s/$RCSEXT$//) {
 253                 $s1 eq $s2;
 254         } else {
 255                 0;
 256         }
 257 }
 258
 259 sub other {
 260         local($s1) = @_;
 261         ($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m|(.*/)(.*)|);
 262         $dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
 263         local($wasrcs) = ($file =~ s/$RCSEXT$//);
 264         if ($wasrcs) {
 265                 `mkdir $dir` unless -d $dir;
 266                 $dir =~ s|RCS/||;
 267         } else {
 268                 $dir .= 'RCS/';
 269                 `mkdir $dir` unless -d $dir;
 270                 $file .= $RCSEXT;
 271         }
 272         "$dir$file";
 273 }
 274
 275 # Perform ~name expansion ala ksh...
 276 # (banish csh from your vocabulary ;-)
 277 sub tilda_expand {
 278         local($path) = @_;
 279         return $path unless $path =~ /^~/;
 280         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 281         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 282         $path;
 283 }
 284
 285 # Set up profile components into %Profile, add any profile-supplied options
 286 # into @ARGV and return the command invocation name.
 287 sub profile {
 288         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 289         local($me) = $0;                # Command name
 290         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 291         return $me unless -s $profile;
 292         local(*PROFILE);                # Local file descriptor
 293         local($options) = '';   # Options we get back from profile
 294         unless (open(PROFILE, $profile)) {
 295                 warn "$me: cannot open $profile: $!\n";
 296                 return;
 297         }
 298         local($_);
 299         local($component);
 300         while (<PROFILE>) {
 301                 next if /^\s*#/;        # Skip comments
 302                 next unless /^$me/o;
 303                 if (s/^$me://o) {       # progname: options
 304                         chop;
 305                         $options .= $_; # Merge options if more than one line
 306                 }
 307                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 308                         $component = $1;
 309                         chop;
 310                         s/^\s+//;               # Trim leading and trailing spaces
 311                         s/\s+$//;
 312                         $Profile{$component} = $_;
 313                 }
 314         }
 315         close PROFILE;
 316         return unless $options;
 317         require 'shellwords.pl';
 318         local(@opts);
 319         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 320         unshift(@ARGV, @opts);
 321         return $me;                             # Return our invocation name
 322 }
 323