bin/patbase

   1 #!/usr/bin/perl
   2         eval "exec perl -S $0 $*"
   3                 if $running_under_some_shell;
   4
   5 # $Id: patbase.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: patbase.SH,v $
  18 # Revision 3.0.1.3  1994/01/24  14:29:24  ram
  19 # patch16: added ~/.dist_profile awareness
  20 #
  21 # Revision 3.0.1.2  1993/08/24  12:15:58  ram
  22 # patch3: random cleanup
  23 #
  24 # Revision 3.0.1.1  1993/08/19  06:42:32  ram
  25 # patch1: leading config.sh searching was not aborting properly
  26 #
  27 # Revision 3.0  1993/08/18  12:10:38  ram
  28 # Baseline for dist 3.0 netwide release.
  29 #
  30
  31 $version = '3.5';
  32 $patchlevel = '0';
  33
  34 $progname = &profile;           # My name
  35
  36 require 'getopts.pl';
  37 &usage unless $#ARGV >= 0;
  38 &usage unless &Getopts("ahV");
  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
  49 $RCSEXT = ',v' unless $RCSEXT;
  50 $TOPDIR = '';                   # We are at the top-level directory
  51
  52 if ($opt_a) {
  53         open(MANI,"MANIFEST.new") || die "No MANIFEST.new found.\n";
  54         @ARGV = ();
  55         while (<MANI>) {
  56                 chop;
  57                 s|^\./||;
  58                 next if m|^patchlevel.h|;               # Special file
  59                 ($_) = split(' ');
  60                 next if -d;
  61                 push(@ARGV,$_);
  62         }
  63         close MANI;
  64 }
  65
  66 foreach $file (@ARGV) {
  67         $files = &rcsargs($file);
  68         @files = split(' ',$files);
  69         $revs=0;
  70         $rlog = `rlog -r$baserev -r$revbranch $files 2>&1`;
  71         ($revs) = ($rlog =~ /selected revisions: (\d+)/);
  72         if (!$revs) {
  73                 print "$progname: $file has never been checked in--checking in...\n";
  74                 system 'perl', '-S', 'patcil', $file;
  75         }
  76         elsif ($revs == 1) {
  77                 print "Last revision for $file is $baserev.\n";
  78                 system 'rcs', "-Nlastpat:$baserev", @files;
  79         }
  80         else {
  81                 ($lastrev) = ($rlog =~ /revision $revbranch\.(\d+)/);
  82                 print "Last revision for $file is $revbranch.$lastrev.\n";
  83                 system 'rcs', "-Nlastpat:$revbranch.$lastrev", @files;
  84         }
  85 }
  86
  87 sub usage {
  88         print STDERR "Usage: $progname [-ahV] [filelist]\n";
  89         print STDERR "  -a : all the files in MANIFEST.new\n";
  90         print STDERR "  -h : print this message and exit\n";
  91         print STDERR "  -V : print version number and exit\n";
  92         exit 1;
  93 }
  94
  95 sub readpackage {
  96         if (! -f '.package') {
  97                 if (
  98                         -f '../.package' ||
  99                         -f '../../.package' ||
 100                         -f '../../../.package' ||
 101                         -f '../../../../.package'
 102                 ) {
 103                         die "Run in top level directory only.\n";
 104                 } else {
 105                         die "No .package file!  Run packinit.\n";
 106                 }
 107         }
 108         open(PACKAGE,'.package');
 109         while (<PACKAGE>) {
 110                 next if /^:/;
 111                 next if /^#/;
 112                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
 113                         $val = "\"$val\"" unless $val =~ /^['"]/;
 114                         eval "\$$var = $val;";
 115                 }
 116         }
 117         close PACKAGE;
 118 }
 119
 120 sub rcsargs {
 121         local($result) = '';
 122         local($_);
 123         while ($_ = shift(@_)) {
 124                 if ($_ =~ /^-/) {
 125                         $result .= $_ . ' ';
 126                 } elsif ($#_ >= 0 && do equiv($_,$_[0])) {
 127                         $result .= $_ . ' ' . $_[0] . ' ';
 128                         shift(@_);
 129                 } else {
 130                         $result .= $_ . ' ' . do other($_) . ' ';
 131                 }
 132         }
 133         $result;
 134 }
 135
 136 sub equiv {
 137         local($s1, $s2) = @_;
 138         $s1 =~ s|.*/||;
 139         $s2 =~ s|.*/||;
 140         if ($s1 eq $s2) {
 141                 0;
 142         } elsif ($s1 =~ s/$RCSEXT$// || $s2 =~ s/$RCSEXT$//) {
 143                 $s1 eq $s2;
 144         } else {
 145                 0;
 146         }
 147 }
 148
 149 sub other {
 150         local($s1) = @_;
 151         ($dir,$file) = ('./',$s1) unless local($dir,$file) = ($s1 =~ m|(.*/)(.*)|);
 152         $dir = $TOPDIR . $dir if -d $TOPDIR . "$dir/RCS";
 153         local($wasrcs) = ($file =~ s/$RCSEXT$//);
 154         if ($wasrcs) {
 155                 `mkdir $dir` unless -d $dir;
 156                 $dir =~ s|RCS/||;
 157         } else {
 158                 $dir .= 'RCS/';
 159                 `mkdir $dir` unless -d $dir;
 160                 $file .= $RCSEXT;
 161         }
 162         "$dir$file";
 163 }
 164
 165 sub rcscomment {
 166         local($file) = @_;
 167         local($comment) = '';
 168         open(FILE,$file);
 169         while (<FILE>) {
 170                 if (/^(.*)\$Log[:\$]/) {        # They know better than us (hopefully)
 171                         $comment = $1;
 172                         last;
 173                 }
 174         }
 175         close FILE;
 176         unless ($comment) {
 177                 if ($file =~ /\.SH$|[Mm]akefile/) {     # Makefile template
 178                         $comment = '# ';
 179                 } elsif ($file =~ /\.U$/) {                     # Metaconfig unit
 180                         $comment = '?RCS: ';
 181                 } elsif ($file =~ /\.man$/) {           # Manual page
 182                         $comment = "''' ";
 183                 } elsif ($file =~ /\.\d\w?$/) {         # Manual page
 184                         $comment = "''' ";
 185                 } elsif ($file =~ /\.[chyl]$/) {        # C source
 186                         $comment = " * ";
 187                 } elsif ($file =~ /\.e$/) {                     # Eiffel source
 188                         $comment = "-- ";
 189                 } elsif ($file =~ /\.pl$/) {            # Perl library
 190                         $comment = ";# ";
 191                 }
 192         }
 193         $comment;
 194 }
 195
 196 # Perform ~name expansion ala ksh...
 197 # (banish csh from your vocabulary ;-)
 198 sub tilda_expand {
 199         local($path) = @_;
 200         return $path unless $path =~ /^~/;
 201         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
 202         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
 203         $path;
 204 }
 205
 206 # Set up profile components into %Profile, add any profile-supplied options
 207 # into @ARGV and return the command invocation name.
 208 sub profile {
 209         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
 210         local($me) = $0;                # Command name
 211         $me =~ s|.*/(.*)|$1|;   # Keep only base name
 212         return $me unless -s $profile;
 213         local(*PROFILE);                # Local file descriptor
 214         local($options) = '';   # Options we get back from profile
 215         unless (open(PROFILE, $profile)) {
 216                 warn "$me: cannot open $profile: $!\n";
 217                 return;
 218         }
 219         local($_);
 220         local($component);
 221         while (<PROFILE>) {
 222                 next if /^\s*#/;        # Skip comments
 223                 next unless /^$me/o;
 224                 if (s/^$me://o) {       # progname: options
 225                         chop;
 226                         $options .= $_; # Merge options if more than one line
 227                 }
 228                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
 229                         $component = $1;
 230                         chop;
 231                         s/^\s+//;               # Trim leading and trailing spaces
 232                         s/\s+$//;
 233                         $Profile{$component} = $_;
 234                 }
 235         }
 236         close PROFILE;
 237         return unless $options;
 238         require 'shellwords.pl';
 239         local(@opts);
 240         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
 241         unshift(@ARGV, @opts);
 242         return $me;                             # Return our invocation name
 243 }
 244