Alt-App-makepatch
view release on metacpan or search on metacpan
* More MsWin issues.
Changes 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.
script/applypatch view on Meta::CPAN
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;
script/applypatch view on Meta::CPAN
}
}
}
sub _open_patch () {
my $p = new IO::File;
$p->open("|$patch") || die ("Cannot open pipe to \"$patch\": $!\n");
binmode($p);
return $p
}
sub execute_patch () {
my $p;
print STDERR ("+ $patch\n") if $trace;
script/makepatch view on Meta::CPAN
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.
script/makepatch view on Meta::CPAN
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");
script/makepatch view on Meta::CPAN
}
# 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}/ ) {
script/makepatch view on Meta::CPAN
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++;
script/makepatch view on Meta::CPAN
$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 <<EOD;
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
script/makepatch view on Meta::CPAN
#
EOD
}
print $fh <<EOD;
#### End of Preamble ####
#### Patch data follows ####
EOD
# Copy patch.
$patch->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",
script/makepatch view on Meta::CPAN
# 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
mkdir("d1") unless -f "d1";
mkdir("d2") unless -f "d2";
chdir("..");
print "not " unless -d "t/d1";
print "ok $test\n";
$test++;
print "not " unless -d "t/d2";
print "ok $test\n";
$test++;
open (D, ">", "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");
( run in 0.309 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )