#!/usr/bin/perl eval "exec perl -S $0 $*" if $running_under_some_shell; # $Id: patftp.SH,v 3.0.1.3 1994/01/24 14:30:43 ram Exp $ # # Copyright (c) 1991-1993, Raphael Manfredi # # You may redistribute only under the terms of the Artistic Licence, # as specified in the README file that comes with the distribution. # You may reuse parts of this distribution only within the terms of # that same Artistic Licence; a copy of which may be found at the root # of the source tree for dist 3.0. # # Original Author: Larry Wall # # $Log: patftp.SH,v $ # Revision 3.0.1.3 1994/01/24 14:30:43 ram # patch16: now prefix error messages with program's name # patch16: added ~/.dist_profile awareness # # Revision 3.0.1.2 1993/08/24 12:16:57 ram # patch3: removed useless orgname variable # # Revision 3.0.1.1 1993/08/19 06:42:36 ram # patch1: leading config.sh searching was not aborting properly # # Revision 3.0 1993/08/18 12:10:44 ram # Baseline for dist 3.0 netwide release. # $version = '3.0'; $patchlevel = '70'; $progname = &profile; # Read ~/.dist_profile require 'getopts.pl'; &usage unless &Getopts("hV"); if ($opt_V) { print STDERR "$progname $version PL$patchlevel\n"; exit 0; } elsif ($opt_h) { &usage; } $RCSEXT = ',v' unless $RCSEXT; chdir '..' if -d '../bugs'; &readpackage; if ($#ARGV < 0) { open(PL,"patchlevel.h") || die "$progname: can't open patchlevel.h: $!\n"; while () { $argv = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/; } close PL; die "$progname: malformed patchlevel.h file.\n" if $argv eq ''; @ARGV = $argv; } else { for (@ARGV) { s/^patch//; } $argv = &rangeargs(@ARGV); @ARGV = split(' ',$argv); } if ($#ARGV < 0) { print STDERR "$progname: no patches specified.\n"; &usage; } elsif ($#ARGV) { print "$progname: copying $package $baserev patches $argv to $ftpdir...\n"; } else { print "$progname: copying $package $baserev patch $argv to $ftpdir...\n"; } chdir 'bugs' || die "$progname: can't cd to bugs: $!\n"; until ($#ARGV < 0) { $patnum = shift; `cp patch$patnum $ftpdir`; } sub usage { print STDERR <) { next if /^:/; next if /^#/; if (($var,$val) = /^\s*(\w+)=(.*)/) { $val = "\"$val\"" unless $val =~ /^['"]/; eval "\$$var = $val;"; } } close PACKAGE; } sub rangeargs { local($result) = ''; local($min,$max,$_); open(PL,"patchlevel.h") || die "Can't open patchlevel.h\n"; while () { $maxspec = $1 if /^#define\s+PATCHLEVEL\s+(\d+)/; } close PL; die "Malformed patchlevel.h file.\n" if $maxspec eq ''; while ($#_ >= 0) { $_ = shift(@_); while (/^\s*\d/) { s/^\s*(\d+)//; $min = $1; if (s/^,//) { $max = $min; } elsif (s/^-(\d*)//) { $max = $1; if ($max == 0 && $maxspec) { $max = $maxspec; } s/^[^,],?//; } else { $max = $min; } for ($i = $min; $i <= $max; ++$i) { $result .= $i . ' '; } } } $result; } # Perform ~name expansion ala ksh... # (banish csh from your vocabulary ;-) sub tilda_expand { local($path) = @_; return $path unless $path =~ /^~/; $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~ $path; } # Set up profile components into %Profile, add any profile-supplied options # into @ARGV and return the command invocation name. sub profile { local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile'); local($me) = $0; # Command name $me =~ s|.*/(.*)|$1|; # Keep only base name return $me unless -s $profile; local(*PROFILE); # Local file descriptor local($options) = ''; # Options we get back from profile unless (open(PROFILE, $profile)) { warn "$me: cannot open $profile: $!\n"; return; } local($_); local($component); while () { next if /^\s*#/; # Skip comments next unless /^$me/o; if (s/^$me://o) { # progname: options chop; $options .= $_; # Merge options if more than one line } elsif (s/^$me-([^:]+)://o) { # progname-component: value $component = $1; chop; s/^\s+//; # Trim leading and trailing spaces s/\s+$//; $Profile{$component} = $_; } } close PROFILE; return unless $options; require 'shellwords.pl'; local(@opts); eval '@opts = &shellwords($options)'; # Protect against mismatched quotes unshift(@ARGV, @opts); return $me; # Return our invocation name }