makepatch-2.03/0000755000076500007650000000000010512174054011224 5ustar jvjvmakepatch-2.03/CHANGES0000644000076500007650000000722510030352457012225 0ustar jvjvChanges in 2.01 --------------- General * Used IO::File instead of IO. * Use binmode for all files, to prevent unicode problems with newer perls. * Modified a few things that required Perl 5.005, so it now runs under 5.004. * Calculate separate checksums for the patch data and the whole patch file. Do not complain if the checksum for the patch file is wrong, if the checksum for the patch data is okay. This allows modification of the preamble of the patch file without affecting the integrity checking mechanism. * Restructured the files in the kit, and added a test program. * A warning is given when installing on Solaris, since the 'patch' program on Solaris (at least the versions I have access to) is buggy to the extent that it is unusable. * Small fixes to avoid warnings under Perl 5.8.x and later. Makepatch * Some systems need to set environment variable TMPDIR (or TEMP) to designate a location for temporary files. Overall changes in makepatch version 2.0 ---------------------------------------- General * The makepatch package now consists of two programs: 'makepatch' and 'applypatch'. 'makepatch' generates the patch kit (using the 'diff' program), 'applypatch' applies it (using the 'patch' program). Makepatch * To avoid most common problems with buggy versions of the 'patch' program, the patch data is relocated to the current directory. This obsoletes the command line options -fixpath and -fixallpath. As a consequence, when a patch is generated from two directories, e.g.: makepatch src-1.0 src-1.1 > the-patch it must be applied *IN* the directory src-1.0, e.g. cd src-1.0; applypatch the-patch When fed to patch directly, no -p option should be used: cd src-1.0; patch < the-patch * (Initial) program options can be specified in environment variable MAKEPATCHINIT, and in preferences files /etc/makepatchrc, $HOME/.makepatchrc and ./.makepatchrc. The latter file name can be overridden with a '-rcfile' option in MAKEPATCHINIT. * Makepatch can take standard source archives (.tar.gz, .tar.bz2, .tar or .zip) as input instead of the sources directories. The -extract command line option can be used to change or add extraction rules. * MANIFEST files are automatically used unless suppressed with the new -nomanifest option. * Files can be excluded from the process with the new command line options -exclude, -exclude_regex, -exclude-vc. Applypatch * The generated patch kit is the concatenation of - a shell preamble; - the actual 'patch' input; - a data section for 'applypatch'. * When applied through 'applypatch', the patch kit will be extensively verified for integrity. Heuristics are applied to the current directory to verify that it is indeed the expected source directory. This directory is prepared for the patching, i.e. new files and directories are created if required. Next, the patch data is passed to the 'patch' program for the actual patching. Finally file modes and timestamps are adjusted. Example: applypatch -d src-1.0 the-patch * When the patch kit is run as a shell script, it will prepare the current directory by creating / removing files and directories as required. The patch kit should then be fed to the 'patch' program. Example: cd src-1.0; sh < the-patch; patch < the-patch * When the patch kit is fed to the 'patch' program, the files in the current directory will be patched. If the directory has not been prepared (e.g. by running the kit as a shell script) the results will very much depend on your 'patch' program. Example: patch -d src-1.0 < the-patch makepatch-2.03/makepatch.spec0000644000076500007650000000577310512174041014045 0ustar jvjvSummary: makepatch -- generate and apply patch kits Name: makepatch Version: 2.03 Release: 1 License: GPL or Perl Artistic Distribution: Free Group: Utilities/Text Source: ftp://ftp.perl.org/pub/CPAN/authors/id/JV/%{name}-%{version}.tar.gz #Patch: Requires: perl >= 5.004 #Prereq: Prefix: /usr/bin Packager: Johan Vromans Vendor: Squirrel Consultancy, Exloo, The Netherlands BuildArch: noarch BuildRoot: /var/tmp/makepatch-buildroot %description This is the makepatch package, containing a pair of programs to assist in the generation and application of patch kits to synchronise source trees. The makepatch package contains two programs, both written in Perl: 'makepatch' and 'applypatch'. 'makepatch' will generate a patch kit from two source trees. It traverses the source directory and runs a 'diff' on each pair of corresponding files, accumulating the output into a patch kit. It knows about the conventions for patch kits: if a file named patchlevel.h exists, it is handled first, so 'patch' can check the version of the source tree. Also, to deal with the non-perfect versions of 'patch' that are in use, it supplies 'Index:' and 'Prereq:' lines, so 'patch' can correctly locate the files to patch, and it relocates the patch to the current directory to avoid problems with creating new files. The list of files can be specified in a so called 'manifest' file, but it can also be generated by recursively traversing the source tree. Files can be excluded using shell style wildcards and Perl regex patterns. Moreover, 'makepatch' prepends a small shell script in front of the patch kit that creates the necessary files and directories for the patch process. By running the patch kit as a shell script your source directory is prepared for the patching process. But that is not it! 'makepatch' also inserts some additional information in the patch kit for use by the 'applypatch' program. The 'applypatch' program will do the following: - It will extensively verify that the patch kit is complete and not corrupted during transfer. - It will apply some heuristics to verify that the directory in which the patch will be applied does indeed contain the expected sources. - It creates files and directories as necessary. - It applies the patch by running the 'patch' program. - Upon completion, obsolete files, directories and .orig files are removed, file modes of new files are set, and the timestamps of all patched files are adjusted. Note that 'applypatch' only requires the 'patch' program. It does not rely on a shell or shell tools. This makes it possible to apply patches on non-Unix systems. %prep %setup #%patch -p0 -b .opt %build perl Makefile.PL make all make test %install mkdir -p $RPM_BUILD_ROOT%{_bindir} mkdir -p $RPM_BUILD_ROOT%{_mandir}/man1 install blib/script/makepatch $RPM_BUILD_ROOT%{_bindir} install blib/script/applypatch $RPM_BUILD_ROOT%{_bindir} install -m 0444 blib/man1/* $RPM_BUILD_ROOT%{_mandir}/man1 %files %doc README CHANGES %{_bindir}/* %{_mandir}/man1/* makepatch-2.03/script/0000755000076500007650000000000010512174054012530 5ustar jvjvmakepatch-2.03/script/applypatch0000644000076500007650000004162610512173773014640 0ustar jvjv#!/usr/bin/perl -w # applypatch -- apply a 'makepatch' generated patch kit. # Author : Johan Vromans # Created On : Sat Nov 14 14:34:28 1998 # Last Modified By: Johan Vromans # Last Modified On: Sun Oct 8 15:07:03 2006 # Update Count : 147 # Status : Released # my $RCS_Id = '$Id: applypatch.pl,v 1.20 2006/10/08 13:07:07 jv Exp $ '; use strict; use Getopt::Long 2.00; use File::Basename; use File::Spec; use IO::File; use Text::ParseWords; ################ Common stuff ################ my $my_package = 'Sciurix'; my $my_name = "applypatch"; my $my_version = "2.03"; my $data_version = '1.0'; $my_version .= '*' if length('$Locker: $ ') > 12; ################ Globals ################ ## Options and defaults. my $dir; # source directory my $check = 0; # check only my $retain = 0; # retain .orig files my $patch = 'patch -p0 -N'; # patch command my $verbose = 0; # verbose processing my $force = 0; # allow continuation after trunc/corruption # Development options (not shown with -help). my $trace = 0; # trace (show process) my $test = 0; # test (no actual processing) my $debug = 0; # extensive debugging info ## Misc my $applypatch = 0; # it's for us my $timestamp; # create date/time of patch kit my @workq = (); # work queue ## Subroutine prototypes sub app_options (); sub app_usage ($); sub copy_input (); sub execute_patch (); sub post_patch (); sub pre_patch (); sub verify_files (); ################ Program parameters ################ app_options(); $trace ||= $debug; $verbose ||= $trace; ################ Presets ################ $patch .= " -s" unless $verbose; my $tmpfile = IO::File->new_tmpfile; ################ The Process ################ # Validate input and copy to temp file. copy_input (); # Change dir if requested. (defined $dir) && (chdir ($dir) || die ("Cannot change to $dir: $!\n")); # Verify that we are in the right place. verify_files (); # Exit if just checking. die ("Okay\n") if $test && $check; exit (0) if $check; # Pre patch: create directories and files. pre_patch (); # Run the patch program. execute_patch (); # Post patch: adjust timestamps, remove obsolete files and directories. post_patch (); die ("Okay\n") if $test; exit (0); ################ Subroutines ################ sub copy_input () { my $lines = 0; # checksum: #lines my $bytes = 0; # checksum: #bytes my $sum = 0; # checksum: system V sum my $all_lines = 0; # overall checksum: #lines my $all_bytes = 0; # overall checksum: #bytes my $all_sum = 0; # overall checksum: system V sum my $patchdata = 0; # saw patch data my $pos = 0; # start of patch data my $endkit = 0; # saw end of kit my $fail = 0; # failed my $patch_checksum_okay = 0;# checksum for the patch was okay print STDERR ("Validate input.\n") if $verbose; @ARGV = "-" if !@ARGV; for my $file (@ARGV) { my $argv = new IO::File; open($argv, $file) or die "Can't open $file: $!"; binmode($argv); while ( <$argv> ) { chomp; if ( /^#### Patch data follows ####/ ) { print STDERR (": $_\n") if $trace; $patchdata |= 1; # bit 0 means: start seen $pos = $tmpfile->getpos; $lines = $bytes = $sum = 0; } elsif ( /^#### End of Patch data ####/ ) { print STDERR (": $_\n") if $trace; $patchdata |= 2; # bit 1 means: end seen } elsif ( /^#### ApplyPatch data follows ####/ ) { print STDERR (": $_\n") if $trace; $applypatch |= 1; } elsif ( /^#### End of ApplyPatch data ####/ ) { print STDERR (": $_\n") if $trace; $applypatch |= 2; } elsif ( /^#### End of Patch kit (\[created: ([^\]]+)\] )?####/ ) { print STDERR (": $_\n") if $trace; $endkit = 1; if ( defined $timestamp && defined $2 && $2 ne $timestamp ) { warn ("Timestamp mismatch ", "in \"#### End of Patch kit\" line.\n", " expecting \"$timestamp\", got \"$2\".\n"); $fail = 1; } } elsif ( /^#### Patch checksum: (\d+) (\d+) (\d+) ####/ ) { # Checksum for patch data only. # This _MUST_ preceed the overall checksum. print STDERR (": $_\n") if $trace; $patch_checksum_okay = 1; if ( $1 != $lines ) { warn ("Linecount error: expecting $1, got $lines.\n"); $fail = 1; $patch_checksum_okay = 0; } if ( $2 != $bytes ) { warn ("Bytecount error: expecting $2, got $bytes.\n"); $fail = 1; $patch_checksum_okay = 0; } if ( $3 != $sum ) { warn ("Checksum error: expecting $3, got $sum.\n"); $fail = 1; $patch_checksum_okay = 0; } } elsif ( /^#### Checksum: (\d+) (\d+) (\d+) ####/ ) { print STDERR (": $_\n") if $trace; if ( $patch_checksum_okay ) { warn ("Warning: Overall linecount mismatch: ". "expecting $1, got $all_lines.\n") unless $1 == $all_lines || !$verbose; warn ("Warning: Overall bytecount mismatch: ". "expecting $2, got $all_bytes.\n") unless $2 == $all_bytes || !$verbose; warn ("Warning: Overall checksum mismatch: ". "expecting $3, got $all_sum.\n") unless $3 == $all_sum || !$verbose; } else { if ( $1 != $all_lines ) { warn ("Overall linecount error: ". "expecting $1, got $all_lines.\n"); $fail = 1; } if ( $2 != $all_bytes ) { warn ("Overall bytecount error: ". "expecting $2, got $all_bytes.\n"); $fail = 1; } if ( $3 != $all_sum ) { warn ("Overall checksum error: ". "expecting $3, got $all_sum.\n"); $fail = 1; } } } elsif ( $applypatch == 1 ) { if ( /^# Data version\s*:\s*(\d+\.\d+)$/ ) { print STDERR (": $_\n") if $trace; if ( $1 > $data_version ) { warn ("This program is not capable of handling ", "this input data.\n", "Please upgrade to a newer version.\n"); $fail = 1; } } elsif ( /^# Date generated\s*:\s+(.*)$/ ) { $timestamp = $1; } elsif ( /^# (\S) (.*)$/ ) { push (@workq, [ $1, shellwords ($2) ]); } } } continue { # Calculate checksum. $lines++; $all_lines++; $_ .= "\n"; $bytes += length ($_); $all_bytes += length ($_); # System V 'sum' checksum $sum = ($sum + unpack ("%16C*", $_)) % 65535; $all_sum = ($all_sum + unpack ("%16C*", $_)) % 65535; # Copy the line to the temp file. print $tmpfile ($_); } close($argv); } # If we saw an ApplyPatch data section, it must be reliable. if ( $applypatch == 1 ) { warn ("ApplyPatch data section not properly terminated.\n"); $fail = 1; } elsif ( $applypatch == 2 ) { warn ("ApplyPatch data section not reliable.\n"); $fail = 1; } if ( $applypatch ) { # If we saw a Patch data section, it must be reliable. if ( $patchdata == 0 ) { warn ("Patch data section not delimited.\n"); $fail = 1; } elsif ( $patchdata == 1 ) { warn ("Patch data section not properly terminated.\n"); $fail = 1; } elsif ( $patchdata == 2 ) { warn ("Patch data section not reliable.\n"); $fail = 1; } if ($endkit == 0 ) { warn ("Missing \"#### End of Patch kit\" line.\n"); $fail = 1; } } if ( $fail ) { if ( $force ) { warn ("WARNING: Verification of patch kit failed, ", "continuing anyway.\n"); } else { die ("Verification of patch kit failed, aborting.\n", "Use \"--force\" to override this.\n"); } } print STDERR ($applypatch == 3 ? "Apply" : "", "Patch kit apparently okay.\n") if $verbose; # Reset file to start of patch data. $tmpfile->setpos ($pos); } sub verify_files () { my $fail = 0; print STDERR ("Verify source directory.\n") if $verbose; foreach ( @workq ) { my ($op, $fn, @args) = @$_; if ( $op eq 'c' ) { if ( -f $fn || -d _ ) { warn ("Verify error: file $fn must be created, ", "but already exists.\n"); $fail = 1; } } elsif ( $op eq 'C' ) { if ( -f $fn || -d _ ) { warn ("Verify error: directory $fn must be created, ", "but already exists.\n"); $fail = 1; } } elsif ( $op eq 'r' || $op eq 'p' || $op eq 'v' ) { my $sz = -s $fn; if ( defined $sz ) { if ( $sz != $args[0] ) { warn ("Verify error: size of $fn should be $args[0], but is ", "$sz.\n"); $fail = 1; } } else { warn ("Verify error: file $fn is missing.\n"); $fail = 1; } } elsif ( $op eq 'R' ) { unless ( -d $fn ) { warn ("Verify error: directory $fn must be removed, ", "but does not exist.\n"); $fail = 1; } } } if ( $fail ) { if ( $force ) { warn ("WARNING: This does not look like expected source ", "directory, continuing anyway.\n"); } else { warn ("Apparently this is not the expected source directory, ", "aborting.\n"); die ("Use \"--force\" to override this.\n"); } } print STDERR ("Source directory apparently okay.\n") if $verbose; } sub pre_patch () { foreach ( @workq ) { my ($op, $fn, $size, $mtime, $mode) = @$_; if ( $op eq 'C' ) { $mode = oct($mode) & 0777; $mode = 0777 unless $mode; # sanity printf STDERR ("+ mkpath $fn 0%o\n", $mode) if $trace; mkdir ($fn, $mode) || die ("Cannot create directory $fn: $!\n"); } } foreach ( @workq ) { my ($op, $fn, $size, $mtime, $mode) = @$_; if ( $op eq 'c' ) { #$mode = oct($mode) & 0777; #$mode = 0666 unless $mode; # sanity print STDERR ("+ create $fn\n") if $trace; open (F, '>'.$fn) || die ("Cannot create $fn: $!\n"); close (F); #printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace; #chmod ($mode, $fn) # || warn sprintf ("WARNING: Cannot chmod 0%o $fn: $!\n", $mode); } } } sub execute_patch () { my $p = new IO::File; print STDERR ("+ $patch\n") if $trace; $p->open("|$patch") || die ("Cannot open pipe to \"$patch\": $!\n"); binmode($p); if ( $applypatch ) { my $lines = 0; while ( <$tmpfile> ) { chomp; $lines++; print STDERR ("++ ", $_, "\n") if $debug; print $p ($_, "\n"); last if $_ eq "#### End of Patch data ####"; } print STDERR ("+ $lines lines sent to \"$patch\"\n") if $trace; } else { print $p ($_) while <$tmpfile>; } $p->close || die ("Possible problems with \"$patch\", status = $?.\n"); } sub set_utime ($$;$) { my ($fn, $mtime, $mode) = @_; $mode = (stat ($fn))[2] unless defined $mode; chmod (0777, $fn) || warn ("WARNING: Cannot utime/chmod a+rwx $fn: $!\n"); print STDERR ("+ utime $fn $mtime (".localtime($mtime).")\n") if $trace; # Set times. Ignore errors for directories since some systems # (like MSWin32) do not allow directories to be stamped. utime ($mtime, $mtime, $fn) || -d $fn || warn ("WARNING: utime($mtime,$fn): $!\n"); printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace; chmod ($mode, $fn) || warn sprintf ("WARNING: Cannot utime/chmod 0%o $fn: $!\n", $mode); } sub do_unlink ($) { my ($fn) = @_; my $mode = (stat($fn))[2]; chmod (0777, $fn) || warn ("WARNING: Cannot unlink/chmod a+rwx $fn: $!\n"); print STDERR ("+ unlink $fn\n") if $verbose; return if unlink ($fn); warn ("WARNING: Cannot remove $fn: $!\n"); chmod ($mode, $fn) || warn sprintf ("WARNING: Cannot unlink/chmod 0%o $fn: $!\n", $mode); } sub do_rmdir ($) { my ($fn) = @_; my $mode = (stat($fn))[2]; chmod (0777, $fn) || warn ("WARNING: Cannot rmdir/chmod a+rwx $fn: $!\n"); print STDERR ("+ rmdir $fn\n") if $verbose; return if rmdir ($fn); warn ("WARNING: Cannot rmdir $fn: $!\n"); chmod ($mode, $fn) || warn sprintf ("WARNING: Cannot rmdir/chmod 0%o $fn: $!\n", $mode); } sub post_patch () { my $suffix = $ENV{SIMPLE_BACKUP_SUFFIX} || ".orig"; foreach ( @workq ) { my ($op, $fn, $size, $mtime, $mode) = @$_; if ( $op eq 'c' || $op eq 'C' || $op eq 'p' ) { if ( defined $mode ) { $mode = oct($mode) & 0777; $mode = 0666 unless $mode; # sanity } set_utime ($fn, $mtime, $mode); next if $retain; $fn .= $suffix; if ( -f $fn ) { do_unlink ($fn); } } elsif ( $op eq 'r' ) { print STDERR ("+ unlink $fn\n") if $trace; # Be forgiving, maybe patch already removed the file. if ( -e $fn ) { do_unlink ($fn); } else { warn ("Apparently, $fn has been removed already.\n"); } } elsif ( $op eq 'R' ) { print STDERR ("+ rmdir $fn\n") if $trace; # Maybe some future version of patch will take care of directories. if ( -e $fn ) { do_rmdir ($fn); } else { warn ("Apparently, $fn has been removed already.\n"); } } } } ################ Options and Help ################ sub app_options () { my $help = 0; # handled locally # Process options, if any. # Make sure defaults are set before returning! return unless @ARGV > 0; my @opts = ('check' => \$check, 'dir|d=s' => \$dir, 'retain' => \$retain, 'force' => \$force, 'verbose' => \$verbose, 'quiet' => sub { $verbose = 0; }, 'patch=s' => \$patch, 'test' => \$test, 'trace' => \$trace, 'debug' => \$debug, 'help' => \$help); (!GetOptions (@opts) || $help) && app_usage (2); } sub app_usage ($) { my ($exit) = @_; print STDERR < [ I ] I =head1 DESCRIPTION B applies a patch kit as generated by the B program. It performs the following actions: =over 4 =item * First, it will extensively verify that the patch kit is complete and did not get corrupted during transfer. =item * Then it will apply some heuristics to verify that the directory in which the patch will be applied does indeed contain the expected sources. If a corruption or verification error is detected, B exits without making changes. =item * If the kit is okay, and the directory seems to be the right one: it creates new files and directories as necessary. =item * Then it runs the B program to apply the patch to the source files. =item * Upon completion, obsolete files, directories and .orig files are removed, file modes of new files are set, and the timestamps of all patched files are adjusted. =back =head1 Applypatch arguments B takes one argument, the name of the patch kit as generated by B. If no name is specified, the patch kit is read from standard input. =head1 Applypatch options Options are matched case insensitive, and may be abbreviated to uniqueness. =over 4 =item B<-directory> I The name of the source directory to be patched. =item B<-check> Perform the checks on the patch kit and patch directory, but do not make any changes. =item B<-force> Force continuation of the patch process even when corruption or verification errors are detected. This is very dangerous! =item B<-retain> Do not remove patch backup files (with extension C<.orig>) upon completion. =item B<-patch> I The patch command to be used. Default is "C". Additionally, a "C<-s>" will be added unless option B<-verbose> was specified. =item B<-verbose> This option will cause B and the B program to emit verbose progress information. =item B<-quiet> This option will cause B and the B program to emit no progress information, only error messages. =back =head1 Environment variables =over 4 =item SIMPLE_BACKUP_SUFFIX The suffix used by (some versions of?) B to back up the originals of patched files. Upon completion, these files are removed by B unless the option B<-retain> was specified. Default value if "C<.orig>". =back =head1 SEE ALSO B(1), B(1), B(1), B(1), B(1). =head1 AUTHOR AND CREDITS This program is written by Johan Vromans . See section AUTHOR AND CREDITS of the makepatch program for an extensive list of people that helped one way or another in the makepatch / applypatch project. =head1 COPYRIGHT AND DISCLAIMER This program is Copyright 1992,1999,2006 by Squirrel Consultancy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of either: a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" which comes with Perl. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the Artistic License for more details. =cut makepatch-2.03/script/makepatch0000644000076500007650000016040710512173757014431 0ustar jvjv#!/usr/bin/perl -w # makepatch.pl -- generate a patch kit from two files or directories. # Author : Johan Vromans # Created On : Tue Jul 7 20:39:39 1992 # Last Modified By: Johan Vromans # Last Modified On: Sun Oct 8 15:06:50 2006 # Update Count : 1187 # Status : Released # my $RCS_Id = '$Id: makepatch.pl,v 1.135 2006/10/08 13:06:55 jv Exp $ '; use strict; use Getopt::Long 2.00; use IO qw(File); use File::Basename; use File::Spec; use File::Path; ################ Common stuff ################ my $my_package = 'Sciurix'; my $my_name = "makepatch"; my $my_version = "2.03"; my $data_version = '1.0'; $my_version .= '*' if length('$Locker: $ ') > 12; ################ Globals ################ ## Options and defaults my $opt_diff = 'diff -c'; # default diff command my $opt_sort; # sort entries. Default = 1 my $opt_follow = 0; # follow symbolic links my $opt_automanifest = "MANIFEST"; my $opt_oldmanifest; # list of files of the old tree my $opt_newmanifest; # list of files of the new tree my $opt_nomanifest = 0; # suppress use of MANIFEST files my $opt_patchlevel; # patchlevel.h file my $opt_prefix = ''; # prefix to be added my $opt_filelist = 0; # make file list my $opt_infocmd; # info command my $opt_exclude_standard = 1; # standard excludes my $opt_exclude_rcs = 0; # exclude RCS files my $opt_exclude_cvs = 0; # exclude CVS files my $opt_exclude_sccs = 0; # exclude SCCS files my $opt_ignore_rcs_keywords = 0; # exclude CVS/RCS keyword data my @opt_exclude; # list of excludes (wildcards) my @opt_exclude_regex; # list of excludes (regex) my $opt_recurse = 1; # recurse my @opt_descr = (); # description my %opt_extract = (); # extraction rules # Development options (not shown with -help). my $opt_trace = 0; # trace messages my $opt_verbose = 0; # verbose info my $opt_quiet = 0; # (almost?) no info my $opt_debug = 0; # debugging messages my $opt_test = 0; # testing ## Misc my $exclude_pat; # regex to exclude my @workq = (); # pre/post work my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP}; $TMPDIR = File::Spec->tmpdir if !$TMPDIR && File::Spec->can("tmpdir"); $TMPDIR ||= "/usr/tmp"; my $dot_u = File::Spec::Unix->curdir; # UNIX current dir my $dot = File::Spec->curdir; # current dir my $dotdot = File::Spec->updir; # parent dir my $HOME = $ENV{HOME} || ($ENV{HOMEDRIVE} && $ENV{HOMEPATH} && $ENV{HOMEDRIVE}.$ENV{HOMEPATH}) || $dot; my $nul = ($^O =~ /^MSWin/i) ? "nul" : "/dev/null"; # NLA0: my $timestamp = "".localtime(); # timestamp, in string format my $nulpat = quotemeta ($nul); # pattern to match nul my $unified = 0; # produce unified diff my $skipped = 0; # number of files skipped. my $excluded = 0; # number of files excluded. ## Subroutine prototypes sub app_options (); sub app_parse_rc ($$$); sub app_usage ($); sub app_usage_filelist ($); sub catfile ($$); sub check_extract ($); sub cleanup (); sub cvs_excludes($$$); sub cvs_ignore($); sub debug (@); sub dodiff ($$$$); sub makepatch (); sub extract ($$); sub filelist ($); sub generate_perl ($); sub generate_shell ($); sub make_filelist ($;$); sub make_filelist_from_manifest ($); sub message (@); sub newfile ($$); sub quotfn ($); sub setup_excludes (); sub showopts ($); sub trace (@); sub verbose (@); sub wrapup (;$); sub yesno ($); ################ INI files, program parameters ################ app_options (); ################ Presets ################ if ( $opt_exclude_sccs ) { unshift (@opt_exclude, qw(p.* s.* SCCS)); } if ( $opt_exclude_rcs ) { unshift (@opt_exclude, ',*', '*,v', qw(RCS RCSLOG)); } if ( $opt_exclude_cvs ) { # Load common .cvsignore, if present. for ( $HOME ."/.cvsignore" ) { unshift (@opt_exclude, cvs_ignore($_)) if -s $_; } unshift (@opt_exclude, '.#*', '#*', qw(_$* *$ CVS CVS.adm cvslog.*)); } if ( $opt_exclude_standard ) { # Common excludes. # Mostly copied from 'Open Source Development with CVS', p. 170. unshift (@opt_exclude, qw(*~ *.a *.bak *.BAK *.elc *.exe *.gz *.ln *.o *.obj *.olb *.old *.orig *.rej *.so *.Z .del-* .make.state .nse_depinfo core tags TAGS)); } setup_excludes (); if ( $opt_ignore_rcs_keywords ) { # Note: We ignore 'Log' since that wouldn't work anyway. $opt_diff .= ' ' . q{'--ignore-matching-lines=\\$\\(} . join('\\|', qw(Author Date Header Id Locker Name RCSfile Revision Source State)) . q{\\)[^$]*\\$'}; } ################ The Process ################ # Handle --filelist. Special but obsolete case. if ( $opt_filelist ) { filelist ($ARGV[0]); die ("Okay\n") if $opt_test; exit (0); } # Check temp dir. unless ( -d $TMPDIR && -w $TMPDIR ) { print STDERR <catdir ($TMPDIR, "mp$$.d"); mkdir ($tmpdir, 0777) or die ("tmpdir: $!\n"); my $thepatch = catfile ($tmpdir, ".mp$$.p"); my $tmpfile = catfile ($tmpdir, ".mp$$.t"); my $patch = new IO::File; # Attach cleanup handler. $SIG{INT} = \&cleanup; $SIG{QUIT} = \&cleanup; # The arguments. my ($old, $new); if ( $] >= 5.005 && $] < 5.008 ) { # Use pseudo-hashes if possible. my %fields = ( tag => 1, # old/new name => 2, # given name on command line root => 3, # real (physical) directory base => 4, # basename (for archives) man => 5, # name of manifest manfn => 6, # same, real file name files => 7, # list of files ); $old = [ \%fields, "old", shift(@ARGV) ]; $new = [ \%fields, "new", shift(@ARGV) ]; } else { $old = { tag => "old", name => shift(@ARGV) }; $new = { tag => "new", name => shift(@ARGV) }; } # Unpack archives, if applicable. # $old->{root} and $new->{root} are the real locations for the source trees. check_extract ($old); check_extract ($new); # The process. makepatch (); # Wrap up. wrapup (); die ("Okay\n") if $opt_test; # In case nothing went wrong... END { cleanup (); } ################ Subroutines ################ sub message (@) { print STDERR (@_) unless $opt_quiet; } sub verbose (@) { print STDERR (@_) if $opt_verbose; } sub debug (@) { print STDERR (@_) if $opt_debug; } sub trace (@) { print STDERR (@_) if $opt_trace; } sub makepatch () { # This will bail out if the directory could not be created. $patch->open(">$thepatch") || die ("$thepatch: $!\n"); binmode($patch); if ( -f $old->{root} && -f $new->{root} ) { # Two files. verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n"); dodiff ($dot, $new->{root}, $dot, $old->{root}) && push (@workq, [ 'p', $old->{root}, -s $old->{root}, (stat($new->{root}))[9], (stat(_))[2] ]); } elsif ( -f $old->{root} && -d $new->{root} ) { # File and dir -> File and dir/File. $new->{root} = $new->{base} = catfile ($new->{root}, $old->{root}); verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n"); if ( -f $new->{root} ) { dodiff ($dot, $new->{root}, $dot, $old->{root}) && push (@workq, [ 'p', $old->{root}, -s $old->{root}, (stat($new->{root}))[9], (stat(_))[2] ]); } else { unshift (@workq, [ 'r', $old->{root}, -s $old->{root}, 0 ]); } } elsif ( -d $old->{root} && -f $new->{root} ) { # Dir and file -> Dir/file and file. $old->{root} = $old->{base} = catfile ($old->{root}, $new->{root}); verbose ("Old file = $old->{root}.\n", "New file = $new->{root}.\n"); if ( -f $old->{root} ) { dodiff ($dot, $new->{root}, $dot, $old->{root}) && push (@workq, [ 'p', $old->{root}, -s $old->{root}, (stat($new->{root}))[9], (stat(_))[2] ]); } else { newfile ($new->{root}, $old->{root}) && push (@workq, [ 'c', $old->{root}, 0, (stat($new->{root}))[9], (stat(_))[2] ]); } } elsif ( -d $old->{root} && -d $new->{root} ) { # Two directories. if ( $opt_nomanifest ) { verbose ("Not using MANIFEST files.\n"); undef $opt_oldmanifest; undef $opt_newmanifest; } elsif ( defined $opt_automanifest && !(defined $opt_oldmanifest || defined $opt_newmanifest) && (-s catfile($old->{root}, $opt_automanifest) && -s catfile($new->{root}, $opt_automanifest)) ) { verbose ("Using standard $opt_automanifest files.\n"); $opt_oldmanifest = catfile($old->{root},$opt_automanifest); $opt_newmanifest = catfile($new->{root},$opt_automanifest); $new->{man} = $old->{man} = $opt_automanifest; $old->{manfn} = $opt_oldmanifest; $new->{manfn} = $opt_newmanifest; } else { $old->{man} = $old->{manfn} = $opt_oldmanifest; $new->{man} = $new->{manfn} = $opt_newmanifest; } for ( $old, $new ) { if ( defined ($_->{manfn}) ) { my $t = $_->{name} eq $dot ? "current directory" : $_->{name} eq $dotdot ? "parent directory" : $_->{base}; $_->{files} = [ make_filelist_from_manifest ($_->{manfn}) ]; message ("Manifest $_->{man} for $t contains ", scalar(@{$_->{files}}), " file", scalar(@{$_->{files}}) == 1 ? "" : "s", ".\n"); } else { my $t = $_->{name} eq $dot ? "current directory" : $_->{name} eq $dotdot ? "parent directory" : "directory $_->{base}"; message ("Building file list for $t ...\n"); $_->{files} = [ make_filelist ($_->{root}) ]; message (ucfirst($t)." contains ", scalar(@{$_->{files}}), " file", scalar(@{$_->{files}}) == 1 ? "" : "s", ".\n"); } } # Handle patchlevel file first. $opt_patchlevel = (grep (/patchlevel\.h/, @{$new->{files}}))[0] unless defined $opt_patchlevel; if ( defined $opt_patchlevel && $opt_patchlevel ne "" ) { my $oldpl = catfile ($old->{root}, $opt_patchlevel); my $newpl = catfile ($new->{root}, $opt_patchlevel); if ( ! -f $newpl ) { die ("$newpl: $!\n"); } if ( -f $oldpl ) { push (@workq, [ dodiff ($new->{root}, $opt_patchlevel, $old->{root}, $opt_patchlevel) ? 'p' : 'v', $opt_patchlevel, -s $oldpl, (stat($newpl))[9], (stat(_))[2] ]); # Remove patchlevel.h from the list of old files. $old->{files} = [ grep ($_ ne $opt_patchlevel, @{$old->{files}}) ]; } else { newfile ($new->{root}, $opt_patchlevel) && push (@workq, [ 'c', $opt_patchlevel, 0, (stat($newpl))[9], (stat(_))[2] ]); } # Remove patchlevel.h from the list of new files. $new->{files} = [ grep ($_ ne $opt_patchlevel, @{$new->{files}}) ]; } else { undef $opt_patchlevel; } my $o; my $n; message ("Processing the filelists ...\n"); while ( scalar(@{$old->{files}}) + scalar(@{$new->{files}}) > 0 || defined $o || defined $n ) { $o = shift (@{$old->{files}}) unless defined $o; $n = shift (@{$new->{files}}) unless defined $n; debug ("* ", $o || "(undef)", " <-> ", $n || "(undef)", " ", "* $old->{files}->[0] <-> $new->{files}->[0]\n") if $opt_debug; if ( defined $n && (!defined $o || $o gt $n) ) { # New file. debug ("*> New file: $n\n"); newfile ($new->{root}, $n) && push (@workq, [ 'c', $n, 0, (stat(catfile($new->{root},$n)))[9], (stat(_))[2] ]); undef $n; } elsif ( !defined $n || $o lt $n ) { # Obsolete (removed) file. debug ("*> Obsolete: $o\n"); unshift (@workq, [ 'r', $o, -s catfile($old->{root},$o), 0 ]); undef $o; } elsif ( $o eq $n ) { # Same file. debug ("*> Compare: $n\n"); dodiff ($new->{root}, $n, $old->{root}, $o) && push (@workq, [ 'p', $o, -s catfile($old->{root},$o), (stat(catfile($new->{root},$n)))[9], (stat(_))[2] ]); undef $n; undef $o; } } } else { $patch->close; app_usage (1); } $patch->close; # For the sake of memory usage... undef $old->{files}; undef $new->{files}; } sub cleanup () { return unless defined $tmpdir; return unless -d $tmpdir; verbose ("Cleaning up...\n"); rmtree ($tmpdir); die ("Okay\n") if $opt_test; exit (0); } sub shellpat($) { my ($pat) = (@_); my @a = split (/(\[[^\]]+\]|[*.?])/, $pat); join ('', (map { ($_ eq '*' ? '.*' : ($_ eq '?' ? '.' : ($_ eq '.' ? '\.' : ($_ =~ /^\[/ ? $_ : quotemeta ($_))))) } @a)); } sub setup_excludes () { # Add --exclude wildcards to --exclude-regex list. if ( @opt_exclude ) { my $pat; foreach $pat ( @opt_exclude ) { push (@opt_exclude_regex, '(\A|/)'.shellpat($pat).'\Z'); } } # Build regex from --exclude-regex list. if ( @opt_exclude_regex ) { $exclude_pat = '('; my $re; foreach $re ( @opt_exclude_regex ) { verbose (" Exclude regex: ", $re, "\n"); eval { '' =~ /$re/ }; if ( $@ ) { $@ =~ s/ at .* line.*$//; die ("Invalid regex: $re $@"); } $exclude_pat .= "($re)|"; } chop ($exclude_pat); $exclude_pat .= ')'; debug ("Exclude pattern: $exclude_pat\n"); } } sub cvs_ignore($) { my ($f) = @_; my $fh = do { local *F; *F; }; unless ( open($fh, $f) ) { warn("$f: $!\n"); return (); } local($/) = undef; my $pat = <$fh>; close($fh); $pat =~ s/[\n\r]+/\n/g; $pat =~ s/\s+$//; $pat =~ s/^\s+//; split(/\n/, $pat); } sub cvs_excludes($$$) { my ($f, $dir, $disp) = @_; my @list = cvs_ignore($f); return "" unless @list; for ( $dir, $disp ) { $_ = "" unless defined $_; $_ .= '/' if $_ && $_ !~ /\/$/; $_ = '\A' . quotemeta($_); } my $ret = ""; foreach my $pat ( @list ) { my $re = shellpat($pat); debug ("$f: '$pat' -> '$re'\n"); eval { '' =~ /$re/ }; if ( $@ ) { $@ =~ s/ at .* line.*$//; warn("$f: invalid pattern '$pat'"); next; } push(@opt_exclude_regex, $dir.$re.'\Z'); $ret .= "($re)|"; } if ( $ret ) { chop($ret); $ret = '('.$disp.'('.$ret.')\Z)'; } debug ("Exclude pattern ($f): $ret\n"); $ret; } sub make_filelist ($;$) { my ($dir, $disp) = @_; # Return a list of files, sorted, for this directory. # Recurses if $opt_recurse. my $dh = new IO::File; trace ("+ recurse $dir\n"); opendir ($dh, $dir) || die ("$dir: $!\n"); my @tmp = readdir ($dh); closedir ($dh); debug ("Dir $dir: ", scalar(@tmp), " entries\n"); my @ret = (); my $file; my $excl = $exclude_pat; for ( catfile($dir, ".cvsignore") ) { $excl = '('.$excl.'|'.cvs_excludes($_,$dir,$disp).')' if -s $_; debug("Exclude pattern: $excl\n"); } foreach $file ( @tmp ) { # Skip unwanted files. next if $file =~ /^\.\.?$/; # dot and dotdot next if $file =~ /~$/; # editor backup files my $realname = catfile ($dir, $file); my $display_name = defined $disp ? catfile($disp,$file) : $file; # Skip exclusions. if ( defined $excl && $display_name =~ /$excl/mso ) { verbose ("Excluding $display_name\n"); $excluded++; next; } # Push on the list. if ( -d $realname && ( $opt_follow || ! -l $realname ) ) { next unless $opt_recurse; # Recurse. push (@ret, make_filelist ($realname, $display_name)); } elsif ( -f _ ) { debug("+ file $display_name\n"); push (@ret, $display_name); } else { verbose ("WARNING: Not a file: $realname -- skipped\n"); $skipped++; } } @ret = sort @ret if $opt_sort; @ret; } sub make_filelist_from_manifest ($) { # Return a list of files, optionally sorted, from a manifest file. my ($man) = @_; my $fh = new IO::File; my @ret = (); local ($_); $fh->open($man) || die ("$man: $!\n"); binmode($fh); while ( <$fh> ) { if ( $. == 2 && /^[-=_\s]*$/ ) { @ret = (); next; } next if /^#/; next unless /\S/; $_ = $1 if /^(\S+)\s/; if ( defined $exclude_pat && /$exclude_pat/mso ) { verbose ("Excluding $_\n"); $excluded++; next; } push (@ret, $_); } $fh->close; @ret = sort @ret if $opt_sort; @ret; } sub check_extract ($) { my ($arg) = @_; my @exctrl = ('.+\.(tar\.gz|tgz)' => "gzip -d | tar xpf -", '.+\.(tar\.bz2)' => "bzip2 -d | tar xpf -", '.+\.(tar)' => "tar xf -", '.+\.(zip)' => "unzip -", ); # Plug in user defined rules. if ( %opt_extract ) { my ($k, $v); while ( ($k,$v) = each (%opt_extract) ) { unshift (@exctrl, $v); unshift (@exctrl, $k); } } $arg->{root} = File::Spec->canonpath ($arg->{name}); my $base = basename ($arg->{root}); while ( @exctrl > 0 ) { my $pat = shift (@exctrl); my $cmd = shift (@exctrl); if ( $base =~ /^$pat$/is ) { extract ($arg, $cmd); verbose ("Using $arg->{root} for $arg->{name}\n") unless $arg->{root} eq $arg->{name}; return; } } $arg->{root} = $arg->{base} = $arg->{name}; } sub extract ($$) { my ($arg, $cmd) = @_; my $tmp = catfile ($tmpdir, $arg->{tag}); message ("Extracting $arg->{name} to $tmp...\n"); # Create a temp directory. mkdir ($tmp, 0777) || die ("Cannot mkdir $tmp [$!]\n"); # Extract the kit. $cmd = "( cd $tmp; $cmd ) < $arg->{name}"; trace ("+ $cmd\n"); my $ret = system ("$cmd 1>&2"); if ( $ret || ($? & 127) ) { die ("Not okay 1\n") if $opt_test; exit (1); } # Inspect the directory. my $dir = new IO::File; opendir ($dir, $tmp) || die ("Cannot read $tmp [$!]\n"); my @files = grep ($_ !~ /^\.+$/, readdir ($dir)); closedir ($dir); # If we have only one directory, assume it is the root. if ( @files == 1 && -d catfile($tmp,$files[0]) ) { $arg->{base} = $files[0]; $arg->{root} = catfile($tmp,$files[0]); return; } # Else, take the temp dir as root. $arg->{root} = $tmp; $arg->{base} = $arg->{name}; } sub catfile ($$) { File::Spec->canonpath(File::Spec->catfile(@_)); } sub dot_file_u ($) { $_[0] =~ s,\\,/,g if $^O =~ /^MSWin/i; File::Spec::Unix->catfile($dot_u, File::Spec::Unix->canonpath(@_)); } sub dodiff ($$$$) { my ($newdir, $new, $olddir, $old) = @_; my $fh = new IO::File; my $oldfn = catfile ($olddir, $old); my $newfn = catfile ($newdir, $new); # Check for binary files. if ( -s $oldfn && -B _ ) { verbose ("WARNING: Binary file $oldfn -- skipped\n"); $skipped++; return 0; } if ( -s $newfn && -B _ ) { verbose ("WARNING: Binary file $newfn -- skipped\n"); $skipped++; return 0; } # Produce a patch hunk. my $cmd = $opt_diff . ' ' . quotfn($oldfn) . ' ' . quotfn($newfn); trace ("+ ", $cmd, "\n"); my $result = system ("$cmd > $tmpfile"); debug (sprintf ("+> result = 0x%x\n", $result)) if $result; if ( $result && $result < 128 ) { wrapup (($result == 2 || $result == 3) ? "User request" : "System error"); die ("Not okay 2\n") if $opt_test; exit (1); } return 0 unless $result == 0x100; # no diffs print $patch ($cmd, "\n"); # Add output from user defined file information command. if ( defined $opt_infocmd ) { my $cmd = $opt_infocmd; $cmd =~ s/\002P/$oldfn/eg; $cmd =~ s/\003P/$newfn/eg; print $patch (`$cmd`); } # By prepending $dot to the names, we can use 'patch -p0' as well # as 'patch -p1'. print $patch ("Index: ", dot_file_u($old), "\n"); # Try to find a prereq. # The RCS code is based on a suggestion by jima@netcom.com, who also # pointed out that patch requires blanks around the prereq string. if ( $fh->open($oldfn) ) { binmode($fh); while ( <$fh> ) { next unless (/(\@\(\#\)\@?|\$Header\:|\$Id\:)(.*)$/); next unless $+ =~ /(\s\d+(\.\d+)*\s)/; # e.g. 5.4 print $patch ("Prereq: $1\n"); last; } $fh->close; } else { warn ("$oldfn: $!\n"); } # Copy patch. $fh->open($tmpfile) || die ("$tmpfile: $!\n"); binmode($fh); # Skip to beginning of patch. Adjust $unified if needed. my $found = 0; while ( <$fh> ) { if ( /^\@\@/ ) { $unified = 1; $found = 1; last; } elsif ( /^\*{15}/ ) { $unified = 0; $found = 1; last; } } unless ( $found ) { die ("ALARM: No patch data found for $old\n", "Something is wrong with your diff command \"$opt_diff\".\n", "It should produce context or unified diff output.\n"); } # Replace patch header. if ( $unified ) { print $patch ("--- ", dot_file_u($old), "\t" . localtime((stat($oldfn))[9]), "\n", "+++ ", dot_file_u($new), "\t" . localtime((stat($newfn))[9]), "\n", $_); } else { print $patch ("*** ", dot_file_u($old), "\t" . localtime((stat($oldfn))[9]), "\n", "--- ", dot_file_u($new), "\t" . localtime((stat($newfn))[9]), "\n", $_); } # Copy rest. print $patch ($_) while <$fh>; $fh->close; return 1; } sub newfile ($$) { # In-line production of what diff would have produced. my ($newdir, $new) = @_; my $fh = new IO::File; my $newfn = catfile ($newdir, $new); my $lines = 0; unless ( $fh->open($newfn) ) { warn ("$newfn: $!\n"); $skipped++; return 0; } binmode($fh); # We cannot trust stdio here. if ( -s $newfn && -B _ ) { verbose ("WARNING: Binary file $new -- skipped\n"); $skipped++; return 0; } my $pos = $fh->getpos; while ( <$fh> ) { $lines++; } $fh->setpos($pos); # Avoid creating a patch if the new file is empty. if ($lines == 0) { return 1; } my $cmd = $opt_diff . " " . $nul . " " . quotfn($newfn); trace ("+ $cmd (inlined)\n"); print $patch ($cmd, "\n"); # Add output from user defined file information command. if ( defined $opt_infocmd ) { my $cmd = $opt_infocmd; $cmd =~ s/\002P/$newfn/eg; $cmd =~ s/\003P/$newfn/eg; print $patch (`$cmd`); } # Prepending $dot, so we can use 'patch -p0' as well as 'patch -p1'. $new = dot_file_u($new); print $patch ("Index: $new\n"); $lines = "1,$lines" unless $lines == 1; if ( $unified ) { print $patch ("--- ", $new, "\t" . localtime(0), "\n", "+++ ", $new, "\t" . localtime((stat($fh))[9]), "\n", "\@\@ -0,0 +", $lines, " \@\@\n"); while ( <$fh> ) { print $patch ("+$_"); } } else { print $patch ("*** ", $new, "\t" . localtime(0), "\n", "--- ", $new, "\t" . localtime((stat($fh))[9]), "\n", "***************\n", "*** 0 ****\n", "--- ", $lines, " ----\n"); while ( <$fh> ) { print $patch ("+ $_"); } } $fh->close; return 1; } sub remove_file ($$) { # diff -c -N -r t1/f2 t2/f2 # *** t1/f2 Tue Jul 7 21:28:45 1992 # --- t2/f2 Thu Jan 1 01:00:00 1970 # *************** # *** 1,1 **** # - foo # - bar # --- 0 ---- # diff -u -N -r t1/f2 t2/f2 # --- t1/f2 Tue Jul 7 21:28:45 1992 # +++ t2/f2 Thu Jan 1 01:00:00 1970 # @@ -1,1 +0,0 @@ # -foo # -bar } sub quotfn ($) { my ($file) = @_; # Protect file name. $file =~ s/`/\\`/g; ($^O =~ /^MSWin/i) ? "\"$file\"" : "'$file'"; } sub wrapup (;$) { my ($reason) = @_; if ( defined $reason ) { warn ("*** Aborted: $reason ***\n"); return; } warn ("WARNING: $skipped file", $skipped == 1 ? " was" : "s were", " skipped!", $opt_verbose ? "" : " Use \"--verbose\" for more details.", "\n") if $skipped; # Construct a description, if possible. if ( @opt_descr == 0 ) { my $old = $old->{base}; my $new = $new->{base}; # We can infer a name if the file name does not contain a # directory part, and is not equal to . or .. if ( $old ne $dot && $old ne $dotdot && basename($old) eq $old && $new ne $dot && $new ne $dotdot && basename($new) eq $new ) { @opt_descr = ("This is a patch for $old to update it to $new"); } } # Get a description, unless provided. if ( @opt_descr == 0 ) { print STDERR ("Enter patch description, ", "terminated with a single '.':\n>> "); while ( ) { chomp; last if $_ eq "."; push (@opt_descr, $_); print STDERR (">> "); } print STDERR ("\n") unless $_ eq "."; } push (@opt_descr, ""); message ("Collecting patches ...\n"); my $removed = 0; # files removed my $created = 0; # files added my $patched = 0; # files patched my $dremoved = 0; # directories removed my $dcreated = 0; # directories created { my @goners = (); my %dir_gone = (); my @newcomers = (); my %dir_ok = (); foreach ( @workq ) { my ($op, $fn) = @$_; push (@newcomers, $fn) if $op eq 'c'; push (@goners, $fn) if $op eq 'r'; $patched++ if $op eq 'p'; } $created = @newcomers; $removed = @goners; foreach ( sort @goners ) { # WARNING: This code assumes you are running some Unix. my @p = split (/\//, $_); pop (@p); foreach my $i ( (1-@p)..0 ) { my $dir = join('/',@p[0..-$i]); unless ( defined $dir_gone{$dir} ) { unless ( -d catfile($new->{root},$dir) ) { $dremoved++; $dir_gone{$dir} = 1; } } } } foreach ( reverse sort keys %dir_gone ) { push (@workq, [ 'R', $_ ]); } foreach ( sort @newcomers ) { # Explicitly create the new files since not all patch versions # can handle creating new files. # Create intermediate directories first. # WARNING: This code assumes you are running some Unix. my @p = split (/\//, $_); pop (@p); foreach my $i ( 0..(@p-1) ) { my $dir = join('/',@p[0..$i]); unless ( defined $dir_ok{$dir} ) { unless ( -d catfile($old->{root},$dir) ) { push (@workq, [ 'C', $dir, 0, (stat(catfile($new->{root},$dir)))[9], (stat(_))[2] ]); $dcreated++; } $dir_ok{$dir} = 1; } } } } my $fh = new IO::File; $fh->open(">$tmpfile") || die ("$tmpfile: $!\n"); binmode($fh); foreach ( @opt_descr ) { print $fh ("# ", $_, "\n"); } print $fh <open($thepatch); binmode($patch); while ( <$patch> ) { print $fh $_; } $patch->close; # Print a reassuring "End of Patch" note so people won't # wonder if their mailer truncated patches. print $fh ("#### End of Patch data ####\n\n", "#### ApplyPatch data follows ####\n", "# Data version : $data_version\n", "# Date generated : $timestamp\n", "# Generated by : $my_name $my_version\n"); print $fh ("# Recurse directories : Yes\n") if $opt_recurse; print $fh ("# Excluded files : ", join("\n# ", @opt_exclude_regex), "\n") if @opt_exclude_regex; foreach ( @workq ) { my ($op, $file, @args) = @$_; $file = quotfn ($file); print $fh ("# ", $op, " ", $file); if ( defined ($args[2]) && ($op eq 'c' || $op eq 'C' || $op eq 'p') ) { $args[2] = sprintf ("0%o", $args[2]); } print $fh (" ", join(" ", @args)) if @args; print $fh ("\n"); } print $fh ("#### End of ApplyPatch data ####\n"); print $fh ("\n#### End of Patch kit [created: $timestamp] ####\n"); $fh->close; # Checksum calculation. # Two checksums are calculated: one for the whole file (for compatibilty), # and one for just the patch data (so the preamble can be modified). my $lines = 0; my $bytes = 0; my $sum = 0; my $all_lines = 0; my $all_bytes = 0; my $all_sum = 0; $fh->open ($tmpfile) || die ("$tmpfile: $!\n"); binmode($fh); binmode(STDOUT); while ( <$fh> ) { $lines = $bytes = $sum = 0 if /^#### Patch data follows ####/; chomp; $_ .= "\n"; $lines++; $all_lines++; $bytes += length ($_); $all_bytes += length ($_); # System V 'sum' checksum $sum = ($sum + unpack ("%16C*", $_)) % 65535; $all_sum = ($all_sum + unpack ("%16C*", $_)) % 65535; print STDOUT ($_); } $fh->close; # Checksum info for the patch data. $_ = "#### Patch checksum: $lines $bytes $sum ####\n"; print STDOUT ($_); $all_lines++; $all_bytes += length ($_); $all_sum = ($all_sum + unpack ("%16C*", $_)) % 65535; # Overall checksum info. print STDOUT ("#### Checksum: $all_lines $all_bytes $all_sum ####\n"); message (" $patched file", $patched == 1 ? "" : "s", " need to be patched.\n"); if ( $created ) { message (" $created file", $created == 1 ? "" : "s"); message (" and $dcreated director", $dcreated == 1 ? "y" : "ies") if $dcreated; message (" need", ($created+$dcreated != 1) ? "" : "s", " to be created.\n"); } if ( $removed ) { message (" $removed file", $removed == 1 ? "" : "s"); message (" and $dremoved director", $dremoved == 1 ? "y" : "ies") if $dremoved; message (" need", ($removed+$dremoved != 1) ? "" : "s", " to be removed.\n"); } message (" $excluded file", $excluded == 1 ? " was" : "s were", " excluded.\n") if $excluded; } sub filelist ($) { my ($man) = @_; my @new = make_filelist_from_manifest ($man); foreach ( @new ) { print STDOUT ($opt_prefix, $_, "\n"); } } sub app_options () { my $opt_manifest; my $opt_help = 0; my $opt_ident = 0; my $opt_rcfile; my @o = ( "automanifest=s" => \$opt_automanifest, "debug!" => \$opt_debug, "description=s@" => \@opt_descr, "diff=s" => \$opt_diff, "exclude-regex=s@" => \@opt_exclude_regex, "exclude-standard!" => \$opt_exclude_standard, "exclude-rcs!" => \$opt_exclude_rcs, "exclude-sccs!" => \$opt_exclude_sccs, "exclude-cvs!" => \$opt_exclude_cvs, "exclude-vc!" => sub { $opt_exclude_rcs = $opt_exclude_cvs = $opt_exclude_sccs = $_[1] }, "exclude=s@" => \@opt_exclude, "extract=s%" => \%opt_extract, "filelist|list!" => \$opt_filelist, "follow!" => \$opt_follow, "help" => \$opt_help, "ident!" => \$opt_ident, "ignore-cvs-keywords|ignore-rcs-keywords!" => \$opt_ignore_rcs_keywords, "infocmd=s" => \$opt_infocmd, "manifest=s" => \$opt_manifest, "newmanifest=s" => \$opt_newmanifest, "nomanifest!" => \$opt_nomanifest, "oldmanifest=s" => \$opt_oldmanifest, "patchlevel=s" => \$opt_patchlevel, "prefix=s" => \$opt_prefix, "quiet!" => \$opt_quiet, "sort!" => \$opt_sort, "recurse!" => \$opt_recurse, "test" => \$opt_test, "trace!" => \$opt_trace, "verbose!" => \$opt_verbose, ); my $init; # Process ENV options. if ( defined ($init = $ENV{MAKEPATCHINIT}) ) { require Text::ParseWords; local (@ARGV) = Text::ParseWords::shellwords ($init); unless ( GetOptions (@o, "rcfile=s" => \$opt_rcfile) && @ARGV == 0 ) { warn ("Error in MAKEPATCHINIT\n"); app_usage (1); } else { trace ("+ INIT: $init\n"); } } unless ( $opt_test ) { # Process ini file options. # First, try system wide file. Unix specific. app_parse_rc ("/etc/makepatchrc", 1, \@o); my $rcname = ".".$my_name."rc"; # Then, try HOME .rc. app_parse_rc (catfile ($HOME, $rcname), 1, \@o); # Then try --rcfile, defaulting to .rc in current dir. if ( defined $opt_rcfile ) { app_parse_rc ($opt_rcfile, 0, \@o); } else { app_parse_rc (catfile ($dot, $rcname), 1, \@o); } } # Process command line options if ( !GetOptions (@o) || $opt_help ) { app_usage (1); } # Argument check. if ( $opt_filelist ) { if ( defined $opt_manifest ) { app_usage (1) if @ARGV; @ARGV = ( $opt_manifest ); } else { app_usage (1) unless @ARGV == 1; } } else { app_usage (1) unless @ARGV == 2; } $opt_trace = 1 if $opt_debug; print STDERR ("This is $my_name version $my_version\n") if $opt_verbose || $opt_ident; if ( $opt_prefix ne '' ) { die ("$0: option \"-prefix\" requires \"-filelist\"\n") unless $opt_filelist; } if ( defined $opt_sort ) { die ("$0: option \"-[no]sort\" requires \"-filelist\"\n") unless $opt_filelist; } else { $opt_sort = 1; } if ( $opt_filelist ) { die ("$0: option \"-filelist\" only uses \"-manifest\"\n") if defined $opt_oldmanifest || defined $opt_newmanifest; } if ( defined $opt_manifest ) { die ("$0: do not use \"-manifest\" with \"-oldmanifest\"". " or \"-newmanifest\"\n") if defined $opt_newmanifest || defined $opt_oldmanifest; $opt_newmanifest = $opt_oldmanifest = $opt_manifest; } if ( defined $opt_infocmd ) { die ("$0: \"-infocmd\" can not be used with \"-filelist\"\n") if $opt_filelist; # Protect %% sequences. $opt_infocmd =~ s/\%\%/\001/g; # Encode %o and %n sequences. $opt_infocmd =~ s/\%o([P])/\002$1/g; $opt_infocmd =~ s/\%n([P])/\003$1/g; # Restore %% sequences. $opt_infocmd =~ s/\001/%%/g; while ( $opt_infocmd =~ /(\%[on]\S)/g ) { warn ("Warning: $1 in info command may become ", "special in the future\n"); } } $opt_verbose = 0 if $opt_quiet; $opt_trace ||= $opt_debug; $opt_verbose ||= $opt_trace; } sub app_parse_rc ($$$) { my ($file, $opt, $optref) = @_; my $rcfile = new IO::File; unless ( $rcfile->open($file) ) { die ("$file: $!\n") unless $opt; return; } require Text::ParseWords; local (@ARGV); my $ok = 1; # Intercept Getopt::Long warning messages. my $warn; $SIG{__WARN__} = sub { $warn = "@_"; }; # Process the file. while ( <$rcfile> ) { # Skip blank and comment lines. next if /^\s*[;#]/; next unless /\S/; # Split. my @a = Text::ParseWords::shellwords ($_); $warn = ''; trace ("+ RC: @a\n"); # Handle. @ARGV = @a; unless ( GetOptions (@$optref) ) { chomp ($warn); print STDERR ("$warn -- at line $. in $file\n"); $ok = 0; } if ( @ARGV > 0 ) { print STDERR ("Garbage \"@ARGV\"", " -- at line $. in $file\n"); $ok = 0; } } $rcfile->close; $SIG{__WARN__} = 'DEFAULT'; unless ( $ok ) { app_usage (1); } $ok; } sub app_usage ($) { my ($exit) = @_; print STDERR < [ I ] I I =for comment B B<-filelist> [ I ] I =head1 Introduction Traditionally, source trees are updated with the B program, processing patch information that is generated by the B program. Although B and B do a very good job at patching file contents, most versions do not handle creating and deleting files and directories, and adjusting of file modes and time stamps. Newer versions of B and B seem to be able to create files, and very new versions of B can remove files. But that's about it. Another typical problem is that patch kits are typically downloaded from the Internet, or transmitted via electronic mail. It is often desirable to verify the correctness of a patch kit before even attempting to apply it. The B package is designed to overcome these limitations. =head1 DESCRIPTION The B package contains two Perl programs: B and B. B will generate a patch kit from two source trees. It traverses the source directory and runs a B on each pair of corresponding files, accumulating the output into a patch kit. It knows about the conventions for patch kits: if a file named C exists, it is handled first, so B can check the version of the source tree. Also, to deal with the non-perfect versions of B that are in use, it supplies "C" and "C" lines, so B can correctly locate the files to patch, and it relocates the patch to the current directory to avoid problems with creating new files. The list of files can be specified in a so called B file, but it can also be generated by recursively traversing the source tree. Files can be excluded using shell style wildcards and Perl regex patterns. But that is not it! B also inserts some additional information in the patch kit for use by the B program. It is important to emphasize that the generated patch kit is still valid input for B. When used with B, there are no verifications and problems may arise when new files need to be created. B prepends a small shell script in front of the patch kit that creates the necessary files and directories for the patch process. If you can not run B for some reason, you can run the patch kit I to prepare the source directory for the patching process. The B program will do the following: =over 4 =item * It will extensively verify that the patch kit is complete and not corrupted during transfer. =item * It will apply some heuristics to verify that the directory in which the patch will be applied does indeed contain the expected sources. =item * It creates files and directories as necessary. =item * It applies the patch by running the B program. =item * Upon completion, obsolete files, directories and C<.orig> files are removed, file modes of new files are set, and the timestamps of all patched files are adjusted. =back Note that B only requires the B program. It does not rely on a shell or shell tools. This makes it possible to apply patches on non-Unix systems. =head1 General usage Suppose you have an archive `C' containing the sources for package `C' version 1.6, and a directory tree `C' containing the sources for version 1.7. The following command will generate a patch kit that updates the 1.6 sources into their 1.7 versions: makepatch pkg-1.6.tar.gz pkg-1.7 > pkg-1.6-1.7.patch To apply this script, go to the directory containing the 1.6 sources and feed the script to B: cd old/pkg-1.6 applypatch pkg-1.6-1.7.patch B will verify that it is executing in the right place and make all necessary updates. By default, B will provide a few lines of progress information, for example: Extracting pkg-1.6.tar.gz to /tmp/mp21575.d/old... Manifest MANIFEST for pkg-1.6 contains 1083 files. Manifest MANIFEST for pkg-1.7 contains 1292 files. Processing the filelists ... Collecting patches ... 266 files need to be patched. 216 files and 8 directories need to be created. 7 files need to be removed. B will provide no feedback information by default. =head1 Makepatch arguments B requires two arguments: I and I. =over 4 =item I This is the name of either a single file or a directory that contains copies of the older version of the target files; in other words, copies of the files I to any modifications. Alternatively, it may be the name of an archive that holds the files to be processed. Allowable archive formats are gzipped tar (name ends in "C<.tar.gz>" or "C<.tgz>"), bzipped tar (name ends in "C<.tar.bz2>"), plain tar (name ends in "C<.tar>" and zip (name ends in "C<.zip>"). =item I This is the name of either a single file or a directory that contains copies of the newer version of the target files; in other words, copies of the files I the modifications have been made. Alternatively, it may be the name of an archive that holds the files to be processed. =back The patch script generated by B will take care of creating new files and directories, update existing files, and remove files and directories that are no longer present in the I directory. =head1 MANIFEST files The purpose of a manifest file is to provide the list of files that constitute a package. Manifest files are traditionally called "C" and reside in the top level directory of the package. Although there is no formal standard for the contents of manifest files, B uses the following rules: =over 4 =item * If the second line from the manifest file looks like a separator line (e.g. it is empty, or contains only dashes), it is discarded and so is the first line. =item * Empty lines and lines that start with a C<#> are ignored. =item * If there are multiple space-separated "words" on a line, the first word is considered to be the filename. =back =head2 Default treatment By default, B looks for files named "C" in the top level directories of the old and the new source trees. If these files (or one of them) are found, they are used. If no manifest file could be found, the package is assumed to consist of all files in the directory. The default name of the default manifest file can be modified with the command line option "C<-automanifest>", see Section L. =head2 Explicitly naming of manifest files Command line options "C<-oldmanifest>" and "C<-newmanifest>" can be used to explicitly designate old and new manifest files. Option "C<-manifest>" is a short way to set one manifest file for both the old and new source trees. =head2 Suppress manifest file processing Command line option "C<-nomanifest>" can be used to suppress all manifest file processing. The package is assumed to consist of all files in the source directories. =head1 Makepatch options B takes several options to control its behaviour. Options are usually specified on the command line, but B can take options from three sources in the following order: =over 4 =item * Environment variable B. When this environment variable is set its contents are considered to be command line options that are processed upon startup. All normal options are allowed, plus one: B<-rcfile >I. Option B<-rcfile> can be used to specify an alternate option file, see below. =item * Options files. B first tries to process a file named B. (This is a Unix-ism.) It is okay if this file is missing. Next, B will process a file named B<.makepatchrc> in the user's home directory, if it exists. After processing this file, B will process a file named B<.makepatchrc> in the current directory, if it exists. An alternative name for this file can be specified with option B<-rcfile> in environment variable B. This is the only way to specify an alternative options file name. In all option files, empty lines and lines starting with C<;> or C<#> are ignored. All other lines are considered to contain options exactly as if they had been supplied on the command line. =item * The command line. =back =head1 Command line options Options are matched case insensitive, and may be abbreviated to uniqueness. =over 4 =item B<-description> I Provide a descriptive text for this patch. Multiple B<-description> options may be supplied. If no description is provided, the program try to guess one. This is usually possible if both directories are simple names, e.g. 'C'. If no description can be determined, the program will ask for one. =item B<-diff> I If specified, I is the command to be used to generate the differences between the two versions of the files. If not specified, this command defaults to "C". For best results, only use "C" or "C". In any case, it B produce either context or unified diff output. =item B<-patchlevel> I If specified, I indicates an alternate file that is to be used in lieu of "B". =item B<-automanifest> I B will automatically use manifest files of the given name if they appear in the directories. The default name is "B". =item B<-nomanifest> Suppress using manifest files. =item B<-manifest> I If specified, I indicates the name of the manifest file which consists of a list of the files contained in both the I and the I directories. =item B<-oldmanifest> I If specified, I indicates the name of the manifest file which consists of a list of the files contained in the I directory. This option is designed to be used in conjunction with the B<-newmanifest> option. Note that the I and I directories must still be indicated. =item B<-newmanifest> I If specified, I indicates the name of the manifest file which consists of a list of the files contained in the I directory. This option is designed to be used in conjunction with the B<-oldmanifest> option. Note that the I and I directories must still be indicated. =item B<->[B]B B recurses through directories by default. Option B<-norecurse> prevents recursion beyond the initial directories. =item B<->[B]B If set, symbolic links to directories are traversed as if they were real directories. =item B<-infocmd> I If specified, the output of running I will be added before each patch chunk. I will undergo the following substitutions first: C<%oP> will be replaced by the name of the old file, C<%nP> will be replaced by the name of the new file. C<%%> will be replaced by a single C<%>; other C<%> sequences may be added in future versions. When a new file is being created, the name of the new file will be supplied for both C<%oP> and C<%nP>. Note that C<%oP> and C<%nP> are modeled after the C<%> sequences of B. =item B<-exclude> I If specified, files that match the shell pattern I will be excluded. Only wildcard characters C<*> and C, and character classes C<[...]> are handled. Multiple B<-exclude> options may be supplied. =item B<-exclude-regex> I If specified, files and directories that match the Perl regular expression pattern I will be excluded. Multiple B<-exclude-regex> options may be supplied. =item B<->[B]B Set by default. If set, a common set of files and directories are ignored. See also section L. =item B<->[B]B If set, files and directories that are usually part of version control system CVS are excluded. Also, C<.cvsignore> files are honoured just like CVS does it. See also section L. =item B<->[B]B If set, files and directories that are usually part of version control system RCS are excluded. See also section L. =item B<->[B]B If set, files and directories that are usually part of version control system SCCS are excluded. See also section L. =item B<->[B]B Short for (re)setting B<-exclude-rcs>, B<-exclude-cvs>, and B<-exclude-sccs>. =item B<->[B]B Differences in CVS keyword data (e.g. C, C
, C) are ignored, provided there are no other differences in the same hunk. This option passes a very hairy regex to the B<--ignore-matching-lines> option of the I program, and hence requires GNU I. This restriction may be lifted in a future version. =item B<->[B]B Same as B<->[B]B. =item B<-extract> IB<=>I Define additional extraction rules for archives. If the name of the source or destination matches the Perl I, the I is executed with the archive on standard input and the current directory set to the location where the files must be extracted. Multiple B<-extract> options may be supplied. User defined rules override built-in rules. Builtin rules are: .+\.(tar\.gz|tgz) => "gzip -d | tar xpf -" .+\.(tar\.bz2) => "bzip2 -d | tar xpf -" .+\.tar => "tar xf -" .+\.zip => "unzip -" The patterns are implicitly anchored to the begin and end of the filename. =begin comment =back =head1 Filelist options =over =item B<->[B]B This option instructs B to read a manifest file, and output the list of files included in this manifest. This option is useful to turn the contents of a manifest file into a list of files suitable for other programs. =item B<-manifest> I If specified, I indicates the name of the manifest file to be used. Alternatively, the name of the manifest file may follow the command line options. =item B<-prefix> I Every entry in the manifest file is prefixed with I before it is written to standard output. =item B<-nosort> Retain the order of filenames from the manifest file. =back The exclude options B<-exclude>, B<-exclude-regex>, B<-exclude-rcs>, B<-exclude-cvs>, B<-exclude-sccs> and B<-exclude-vc> can also be used with B. =over * =end comment =item B<->[B]B If set, the program name and version is reported. =item B<->[B]B This is set by default, making B display information concerning its activity to I. =item B<->[B]B The opposite of B<-verbose>. If set, this instructs B to suppress the display of activity information. =item B<->[B]B If set, this causes a short help message to be displayed, after which the program immediately exits. =back =head1 Standard Exclude Patterns The following file patterns are always excluded: *~ *.a *.bak *.BAK *.elc *.exe *.gz *.ln *.o *.obj *.olb *.old *.orig *.rej *.so *.Z .del-* .make.state .nse_depinfo core tags TAGS Option B<-exclude-sccs> adds: p.* s.* SCCS Option B<-exclude-rcs> adds: ,* *,v RCS RCSLOG Option B<-exclude-cvs> adds C<.cvsignore> patterns, and: .#* #* _$* *$ CVS CVS.adm cvslog.* Please let me know if I missed some. =head1 Environment variables =over =item MAKEPATCHINIT When this environment variable is set its contents is considered to be command line options that are processed upon startup. All normal options are allowed, plus one: B<-rcfile >I. If B<-rcfile> is specified, the file is read and all lines of it are considered to contain option settings as described in section L. =item TMPDIR C can be used to designate the area where temporary files are placed. It defaults to C. =item TEMP C can be used as an alternative to C. =back =head1 Examples Suppose you have a directory tree `C' containing the sources for package `C' version 1.6, and a directory tree `C' containing the sources for version 1.7. The following command will generate a patch kit that updates the 1.6 sources into their 1.7 versions: makepatch pkg-1.6 pkg-1.7 > pkg-1.6-1.7.patch To apply this script, go to the pkg-1.6 directory and feed the script to B: cd old/pkg-1.6 applypatch pkg-1.6-1.7.patch B will verify that it is executing in the right place and make all necessary updates. This is one way to generate and use manifest files: (cd pkg-1.6; find . -type f -print > OLDMANIFEST) (cd pkg-1.7; find . -type f -print > NEWMANIFEST) makepatch \ -oldmanifest pkg-1.6/OLDMANIFEST \ -newmanifest pkg-1.7/NEWMANIFEST \ pkg-1.6 pkg-1.7 > pkg-1.6-1.7.diff =begin comment The following example transforms the manifest file into a list of files suitable for GNU tar. Note the trailing C in the prefix string: makepatch -filelist -prefix pkg-1.7/ pkg-1.7/MANIFEST | \ tar -cvf - -T -Op | gzip > pkg-1.7.tar.gz =end comment =head1 Bugs and restrictions Much of the job of B is processing file names. B has been tested extensively on Unix systems, but it is not guaranteed to work on other systems. B is repeatedly reported to correctly process B generated patch kits on modern 32-bit Windows systems as well. B does not know about symbolic links. These will be treated like plain files. Wrong results can be generated if the file lists that are used or generated use different path separators. =head1 SEE ALSO B(1), B(1), B(1), B(1), B(1). =head1 AUTHOR AND CREDITS Johan Vromans (jvromans@squirrel.nl) wrote the program, with a little help and inspiration from: Jeffery Small, Ulrich Pfeifer, Nigel Metheringham, Julian Yip, Tim Bunce, Gurusamy Sarathy, Hugo van der Sanden, Rob Browning, Joshua Pritikin, and others. =head1 COPYRIGHT AND DISCLAIMER This program is Copyright 1992,2004,2006 by Squirrel Consultancy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of either: a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" which comes with Perl. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the Artistic License for more details. =cut makepatch-2.03/MANIFEST0000644000076500007650000000032010512174054012350 0ustar jvjvREADME INSTALL MANIFEST Makefile.PL script/makepatch script/applypatch CHANGES makepatch.spec t/basic.t t/d1/tdata1 t/d2/tdata1 META.yml Module meta-data (added by MakeMaker) makepatch-2.03/t/0000755000076500007650000000000010512174054011467 5ustar jvjvmakepatch-2.03/t/basic.t0000644000076500007650000000563110512173532012742 0ustar jvjv#! perl require 5.004; if ( $^O eq "solaris" ) { print STDERR <t/d1/tdata1"); binmode(D); print D $data1; close D; open (D, ">t/d2/tdata1"); binmode(D); print D $data2; close D; open (D, ">t/d1/tdata2"); binmode(D); print D $data2; close D; open (D, ">t/d2/tdata2"); binmode(D); print D $data1; close D; my $tmpout = "basic.out"; $ENV{MAKEPATCHINIT} = "-test"; @ARGV = qw(-test -quiet -description test t/d1 t/d2); eval { package MakePatch; local (*STDOUT); open (STDOUT, ">$tmpout"); local (*STDERR); open (STDERR, ">&STDOUT"); require "blib/script/makepatch"; }; # Should exit Okay. if ( !$@ || $@ =~ /^Okay/ ) { print "ok 1\n"; } else { print "not ok 1\n"; print $@; } # Run makepatch's END block eval { MakePatch::cleanup (); }; # And blank it. undef &MakePatch::cleanup; *MakePatch::cleanup = sub {}; # Expect some output. print "not " unless -s $tmpout > 1300; print "ok 2\n"; my $tmpou2 = "basic.ou2"; @ARGV = qw(-test -dir t/d1 basic.out); eval { package ApplyPatch; local (*STDOUT); open (STDOUT, ">$tmpou2"); local (*STDERR); open (STDERR, ">&STDOUT"); require "blib/script/applypatch"; }; # applypatch will chdir to t/d1; change back. chdir ("../.."); # Should exit Okay. if ( $@ =~ /^Okay/ ) { print "ok 3\n"; } else { print "not ok 3\n"; print $@; } # Expect no output. # print "not " if -s $tmpou2 > 0; { my $s; if ( ($s = -s $tmpou2) > 0 ) { open (FX, $tmpou2) or die ("$tmpou2: $!\n"); local $/; my $c = ; close (FX); $c =~ s/^/####/gm; $c .= "####"; print ("# tmpou2[$tmpou2]s[$s]c[$c]\nnot "); } } print "ok 4\n"; # Remove temp files. unlink $tmpout, $tmpou2; # Verify resultant data. print "not " if differ ("t/d1/tdata1", "t/d2/tdata1"); print "ok 5\n"; print "not " if differ ("t/d1/tdata1", "t/d2/tdata1"); print "ok 6\n"; sub differ { # Perl version of the 'cmp' program. # Returns 1 if the files differ, 0 if the contents are equal. my ($old, $new) = @_; unless ( open (F1, $old) ) { print STDERR ("$old: $!\n"); return 1; } unless ( open (F2, $new) ) { print STDERR ("$new: $!\n"); return 1; } my ($buf1, $buf2); my ($len1, $len2); while ( 1 ) { $len1 = sysread (F1, $buf1, 10240); $len2 = sysread (F2, $buf2, 10240); return 0 if $len1 == $len2 && $len1 == 0; return 1 if $len1 != $len2 || ( $len1 && $buf1 ne $buf2 ); } } makepatch-2.03/t/d2/0000755000076500007650000000000010512174054011774 5ustar jvjvmakepatch-2.03/t/d2/tdata10000644000076500007650000000007410512174026013075 0ustar jvjvSquirrel Consultancy Duivenvoordestraat 46 2013 AG Haarlem makepatch-2.03/t/d1/0000755000076500007650000000000010512174054011773 5ustar jvjvmakepatch-2.03/t/d1/tdata10000644000076500007650000000007410512174026013074 0ustar jvjvSquirrel Consultancy Duivenvoordestraat 46 2013 AG Haarlem makepatch-2.03/INSTALL0000644000076500007650000000111406627016470012263 0ustar jvjvINSTALLATION - Edit Makefile.PL (if needed) - Type 'perl Makefile.PL' - Type 'make' blib/script/makepatch is the makepatch program blib/script/applypatch is the applypatch program blib/man1/makepatch.1 is the manual page for makepatch blib/man1/applypatch.1 is the manual page for applypatch - Type 'make install' to install the program and the documentation on your system. This usually requires super user privileges. REQUIREMENTS - Perl 5.005 standard installation. - For 'makepatch': the 'diff' program. - For 'applypatch': the 'patch' program. makepatch-2.03/README0000644000076500007650000000676710506743343012132 0ustar jvjvThis is the makepatch package, containing a pair of programs to assist in the generation and application of patch kits to synchronise source trees. INTRODUCTION Traditionally, source trees are updated with the 'patch' program, processing patch information that is generated by the 'diff' program. Although 'diff' and 'patch' do a very good job at patching file contents, most versions do not handle creating and deleting files and directories, and adjusting of file modes and time stamps. Newer versions of 'diff' and 'patch' seem to be able to create files, and very new versions of 'patch' can remove files. But that's about it. Another typical problem is that patch kits are typically downloaded from the Internet, or transmitted via electronic mail. It is often desirable to verify the correctness of a patch kit before even attempting to apply it. The makepatch package is designed to overcome these limitations. DESCRIPTION The makepatch package contains two programs, both written in Perl: 'makepatch' and 'applypatch'. 'makepatch' will generate a patch kit from two source trees. It traverses the source directory and runs a 'diff' on each pair of corresponding files, accumulating the output into a patch kit. It knows about the conventions for patch kits: if a file named patchlevel.h exists, it is handled first, so 'patch' can check the version of the source tree. Also, to deal with the non-perfect versions of 'patch' that are in use, it supplies 'Index:' and 'Prereq:' lines, so 'patch' can correctly locate the files to patch, and it relocates the patch to the current directory to avoid problems with creating new files. The list of files can be specified in a so called 'manifest' file, but it can also be generated by recursively traversing the source tree. Files can be excluded using shell style wildcards and Perl regex patterns. Moreover, 'makepatch' prepends a small shell script in front of the patch kit that creates the necessary files and directories for the patch process. By running the patch kit as a shell script your source directory is prepared for the patching process. But that is not it! 'makepatch' also inserts some additional information in the patch kit for use by the 'applypatch' program. The 'applypatch' program will do the following: - It will extensively verify that the patch kit is complete and not corrupted during transfer. - It will apply some heuristics to verify that the directory in which the patch will be applied does indeed contain the expected sources. - It creates files and directories as necessary. - It applies the patch by running the 'patch' program. - Upon completion, obsolete files, directories and .orig files are removed, file modes of new files are set, and the timestamps of all patched files are adjusted. Note that 'applypatch' only requires the 'patch' program. It does not rely on a shell or shell tools. This makes it possible to apply patches on non-Unix systems. REQUIREMENTS - Perl 5.004 standard installation. - For 'makepatch': the 'diff' program. - For 'applypatch': the 'patch' program. -------------------------------------------------------------------------- Johan Vromans jvromans@squirrel.nl Squirrel Consultancy Haarlem, the Netherlands http://www.squirrel.nl http://www.squirrel.nl/people/jvromans PGP Key 2048/4783B14D KFP=65 44 CA 66 B3 50 0B 34 CE 0E FB CA 2D 95 34 D0 ---------------------- "Arms are made for hugging" ----------------------- makepatch-2.03/Makefile.PL0000644000076500007650000000551010512174012013171 0ustar jvjv# Makefile.PL -- Makefile for makepatch # Author : Ulrich Pfeifer # Created On : Mon Feb 17 10:51:47 1997 # Last Modified By: Johan Vromans # Last Modified On: Sun Oct 8 15:07:22 2006 # Update Count : 105 # Status : Released # Verify perl version. require 5.004; # Verify CORE modules. use Getopt::Long 2.00; use IO qw(File); use File::Basename; use File::Spec; use Config; use ExtUtils::MakeMaker; # WriteMakefile parameter hash. my %p = ( NAME => 'makepatch', VERSION => "2.03" ); # Extra info for newer versions. if ( $[ >= 5.005 ) { $p{AUTHOR} = 'Johan Vromans (jvromans@squirrel.nl)'; $p{ABSTRACT} = 'patchkit generate and apply tool'; } # Scripts. my @scripts = qw (makepatch applypatch); my $usrbin = "/usr/bin"; my $installscript = $Config{installscript}; print STDERR ("\n", "WARNING: This Makefile will install user accessible scripts.\n"); print STDERR ("The location for these scripts is $installscript.\n") unless $installscript eq $usrbin; print STDERR ("You may consider to pass INSTALLSCRIPT=$usrbin (or some other\n", "convenient location) to \"make install\".\n\n"); if ( $^O eq "solaris" ) { print STDERR <tmpdir if !$TMPDIR && File::Spec->can("tmpdir"); $TMPDIR ||= "/usr/tmp"; unless ( -d $TMPDIR && -w $TMPDIR ) { print STDERR < 0, Text::Diff => 0, Text::Patch => 0, ); # Check modules, and ask to install them now. $p{PREREQ_PM} = {}; foreach ( sort keys %req ) { my $mod = $_; my $rev = $req{$mod}; my $eval = "use $mod $rev"; eval $eval; if ( $@ ) { print STDERR ("\nI need the $mod package", ($rev ? ", version $rev or higher" : ""), ".\n", "Shall I install it for you? "); my $ans = ; if ( $ans =~ /^y/i ) { $mod =~ s/::/\//g; push (@mods, "$mod.pm"); } else { # Have MakeMaker complain. $p{PREREQ_PM}->{$mod} = 0; } } } =cut # Append scripts and modules to WriteMakefile args. $p{EXE_FILES} = [ map { "script/$_" } @scripts ]; foreach ( @mods ) { $p{PM}->{"lib/$_"} = '${INST_LIBDIR}'."/$_"; } # Write the Makefile. WriteMakefile (%p); makepatch-2.03/META.yml0000644000076500007650000000043610512174054012500 0ustar jvjv# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: makepatch version: 2.03 version_from: installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30