Dpkg::Source::Patch gains last features from dpkg-source

* scripts/Dpkg/Source/Patch.pm: New analyze() function that
replaces dpkg-source's checkdiff(). Check sanity of patch,
and reports directories to create and list of patched files.
* scripts/Dpkg/Source/Patch.pm (apply): Create required
directories on the fly and adjust timestamp of patched
files. This behaviour is configurable.
* scripts/dpkg-source.pl: Adjust accordingly.
* scripts/Dpkg/Source/Patch.pm (add_diff_file): Support
new option include_timestamp.

scripts/Dpkg/Source/Patch.pm

@@ -31,7 +31,10 @@ use POSIX;
 use File::Find;
 use File::Basename;
 use File::Spec;
+use File::Path;
 use Fcntl ':mode';
+#XXX: Needed for sub-second timestamps, require recent perl
+#use Time::HiRes qw(stat);
 
 use base 'Dpkg::Source::CompressedFile';
 
@@ -55,6 +58,7 @@ sub create {
 
 sub add_diff_file {
     my ($self, $old, $new, %opts) = @_;
+    $opts{"include_timestamp"} = 0 unless exists $opts{"include_timestamp"};
     # Default diff options
     my @options;
     if ($opts{"options"}) {
@@ -64,9 +68,20 @@ sub add_diff_file {
     }
     # Add labels
     if ($opts{"label_old"} and $opts{"label_new"}) {
-        # Space in filenames need special treatment
-        $opts{"label_old"} .= "\t" if $opts{"label_old"} =~ / /;
-        $opts{"label_new"} .= "\t" if $opts{"label_new"} =~ / /;
+	if ($opts{"include_timestamp"}) {
+	    my $ts = (stat($old))[9];
+	    my $t = POSIX::strftime("%Y-%m-%d %H:%M:%S", gmtime($ts));
+	    $opts{"label_old"} .= sprintf("\t%s.%09d +0000", $t,
+					    ($ts-int($ts))*1000000000);
+	    $ts = (stat($new))[9];
+	    $t = POSIX::strftime("%Y-%m-%d %H:%M:%S", gmtime($ts));
+	    $opts{"label_new"} .= sprintf("\t%s.%09d +0000", $t,
+					    ($ts-int($ts))*1000000000);
+	} else {
+	    # Space in filenames need special treatment
+	    $opts{"label_old"} .= "\t" if $opts{"label_old"} =~ / /;
+	    $opts{"label_new"} .= "\t" if $opts{"label_new"} =~ / /;
+	}
         push @options, "-L", $opts{"label_old"},
                        "-L", $opts{"label_new"};
     }
@@ -235,12 +250,132 @@ sub _fail_not_same_type {
     $self->{'errors'}++;
 }
 
+# check diff for sanity, find directories to create as a side effect
+sub analyze {
+    my ($self, $destdir, %opts) = @_;
+
+    my $diff = $self->get_filename();
+    my $diff_handle = $self->open_for_read();
+    my %filepatched;
+    my %dirtocreate;
+    my $diff_count = 0;
+
+    $_ = <$diff_handle>;
+
+  HUNK:
+    while (defined($_) || not eof($diff_handle)) {
+	# skip comments leading up to patch (if any)
+	until (/^--- /) {
+	    last HUNK if not defined($_ = <$diff_handle>);
+	}
+	chomp;
+	$diff_count++;
+	# read file header (---/+++ pair)
+	unless(s/^--- //) {
+	    error(_g("expected ^--- in line %d of diff `%s'"), $., $diff);
+	}
+	s/\t.*//; # Strip any timestamp at the end
+	unless ($_ eq '/dev/null' or s{^(\./)?[^/]+/}{$destdir/}) {
+	    error(_g("diff `%s' patches file with no subdirectory"), $diff);
+	}
+	if (/\.dpkg-orig$/) {
+	    error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff);
+	}
+	my $fn = $_;
+
+	unless (defined($_= <$diff_handle>) and chomp) {
+	    error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.);
+	}
+	s/\t.*//; # Strip any timestamp at the end
+	unless (s/^\+\+\+ // and ($_ eq '/dev/null' or s!^(\./)?[^/]+/!!)) {
+	    error(_g("line after --- isn't as expected in diff `%s' (line %d)"),
+	          $diff, $.);
+	}
+
+	if ($fn eq '/dev/null') {
+	    error(_g("original and modified files are /dev/null in diff `%s' (line %d)"),
+		  $diff, $.) if $_ eq '/dev/null';
+	    $fn = "$destdir/$_";
+	} else {
+	    unless ($_ eq substr($fn, length($destdir) + 1)) {
+		printf("$_ $fn $destdir %s",  substr($fn, length($destdir) + 1));
+	        error(_g("line after --- isn't as expected in diff `%s' (line %d)"),
+	              $diff, $.);
+	    }
+	}
+
+	my $dirname = $fn;
+	if ($dirname =~ s{/[^/]+$}{} && not -d $dirname) {
+	    $dirtocreate{$dirname} = 1;
+	}
+	if (-e $fn and not -f _) {
+	    error(_g("diff `%s' patches something which is not a plain file"), $diff);
+	}
+
+	if ($filepatched{$fn}) {
+	    error(_g("diff `%s' patches file %s twice"), $diff, $fn);
+	}
+	$filepatched{$fn} = 1;
+
+	# read hunks
+	my $hunk = 0;
+	while (defined($_ = <$diff_handle>)) {
+	    # read hunk header (@@)
+	    chomp;
+	    next if /^\\ No newline/;
+	    last unless (/^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/);
+	    my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1);
+	    # read hunk
+	    while ($olines || $nlines) {
+		unless (defined($_ = <$diff_handle>)) {
+		    error(_g("unexpected end of diff `%s'"), $diff);
+		}
+		unless (chomp) {
+		    error(_g("diff `%s' is missing trailing newline"), $diff);
+		}
+		next if /^\\ No newline/;
+		# Check stats
+		if    (/^ /)  { --$olines; --$nlines; }
+		elsif (/^-/)  { --$olines; }
+		elsif (/^\+/) { --$nlines; }
+		else {
+		    error(_g("expected [ +-] at start of line %d of diff `%s'"),
+		          $., $diff);
+		}
+	    }
+	    $hunk++;
+	}
+	unless($hunk) {
+	    error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff);
+	}
+    }
+    close($diff_handle);
+    unless ($diff_count) {
+	error(_g("diff `%s' doesn't contain any patch"), $diff);
+    }
+    $self->cleanup_after_open();
+    $self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate;
+    $self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched;
+    return $self->{'analysis'}{$destdir};
+}
+
 sub apply {
     my ($self, $destdir, %opts) = @_;
-    # TODO: check diff
-    # TODO: create missing directories
+    # Set default values to options
+    $opts{"force_timestamp"} = 1 unless exists $opts{"force_timestamp"};
+    $opts{"remove_backup"} = 1 unless exists $opts{"remove_backup"};
+    $opts{"create_dirs"} = 1 unless exists $opts{"create_dirs"};
     $opts{"options"} ||= [ '-s', '-t', '-F', '0', '-N', '-p1', '-u',
             '-V', 'never', '-g0', '-b', '-z', '.dpkg-orig'];
+    # Check the diff and create missing directories
+    my $analysis = $self->analyze($destdir, %opts);
+    if ($opts{"create_dirs"}) {
+	foreach my $dir (keys %{$analysis->{'dirtocreate'}}) {
+	    eval { mkpath($dir, 0, 0777); };
+	    syserr(_g("cannot create directory %s"), $dir) if $@;
+	}
+    }
+    # Apply the patch
     my $diff_handle = $self->open_for_read();
     fork_and_exec(
 	'exec' => [ 'patch', @{$opts{"options"}} ],
@@ -250,6 +385,19 @@ sub apply {
 	'from_handle' => $diff_handle
     );
     $self->cleanup_after_open();
+    # Reset the timestamp of all the patched files
+    # and remove .dpkg-orig files
+    my $now = $opts{"timestamp"} || time;
+    foreach my $fn (keys %{$analysis->{'filepatched'}}) {
+	if ($opts{"force_timestamp"}) {
+	    utime($now, $now, $fn) ||
+		syserr(_g("cannot change timestamp for %s"), $fn);
+	}
+	if ($opts{"remove_backup"}) {
+	    $fn .= ".dpkg-orig";
+	    unlink($fn) || syserr(_g("remove patch backup file %s"), $fn);
+	}
+    }
 }
 
 # Helper functions

scripts/dpkg-source.pl

@@ -106,18 +106,15 @@ my %override;
 # Files
 my %checksum;
 my %size;
-my %type;		 # used by checktype
-my %filepatched;	 # used by checkdiff
-my %dirtocreate;	 # used by checkdiff
 
 my @tar_ignore;
 
 my $substvars = Dpkg::Substvars->new();
 
 use POSIX;
-use Fcntl qw (:mode);
+use Fcntl qw(:mode);
 use English;
-use File::Temp qw (tempfile);
+use File::Temp qw(tempfile);
 
 textdomain("dpkg-dev");
 
@@ -857,7 +854,6 @@ if ($opmode eq 'build') {
     $expectprefix = $newdirectory;
     $expectprefix .= '.orig' if $difffile || $debianfile;
     
-    checkdiff("$dscdir/$difffile") if $difffile;
     printf(_g("%s: extracting %s in %s")."\n",
            $progname, $sourcepackage, $newdirectory)
         || &syserr(_g("write extracting message"));
@@ -945,9 +941,7 @@ if ($opmode eq 'build') {
 	{
 	    # patches match same rules as run-parts
 	    next unless /^[\w-]+$/ and -f "$pd/$_";
-	    my $p = $_;
-	    checkdiff("$pd/$p");
-	    push @p, $p;
+	    push @p, $_;
 	}
 
 	closedir D;
@@ -955,23 +949,6 @@ if ($opmode eq 'build') {
 	push @patches, map "$newdirectory/debian/patches/$_", sort @p;
     }
 
-    for my $dircreate (keys %dirtocreate) {
-	my $dircreatem = "";
-	for my $dircreatep (split("/", $dircreate)) {
-	    $dircreatem .= $dircreatep . "/";
-	    if (!lstat($dircreatem)) {
-		$! == ENOENT || syserr(_g("cannot stat %s"), $dircreatem);
-		mkdir($dircreatem,0777)
-		    || syserr(_g("failed to create %s subdirectory"), $dircreatem);
-	    }
-	    else {
-		-d _ || error(_g("diff patches file in directory `%s', " .
-		                 "but %s isn't a directory !"),
-		              $dircreate, $dircreatem);
-	    }
-	}
-    }
-
     if ($newdirectory ne $expectprefix)
     {
 	rename($expectprefix,$newdirectory) ||
@@ -985,19 +962,11 @@ if ($opmode eq 'build') {
 	              "$newdirectory.tmp-keep", $expectprefix);
     }
 
+    my $now = time;
     for my $patch (@patches) {
 	printf(_g("%s: applying %s")."\n", $progname, $patch);
 	my $patch_obj = Dpkg::Source::Patch->new(filename => $patch);
-	$patch_obj->apply($newdirectory);
-    }
-
-    my $now = time;
-    for $fn (keys %filepatched) {
-	my $ftr = "$newdirectory/" . substr($fn, length($expectprefix) + 1);
-	utime($now, $now, $ftr) ||
-	    syserr(_g("cannot change timestamp for %s"), $ftr);
-	$ftr.= ".dpkg-orig";
-	unlink($ftr) || syserr(_g("remove patch backup file %s"), $ftr);
+	$patch_obj->apply($newdirectory, timestamp => $now);
     }
 
     if (!(my @s = lstat("$newdirectory/debian/rules"))) {
@@ -1033,136 +1002,12 @@ sub erasedir {
     failure(_g("rm -rf failed to remove `%s'"), $dir);
 }
 
-# check diff for sanity, find directories to create as a side effect
-sub checkdiff
-{
-    my $diff = shift;
-    my ($diff_handle, $compressor);
-    if ($diff =~ /\.$comp_regex$/) {
-	$compressor = Dpkg::Source::Compressor->new();
-	$compressor->uncompress(from_file => $diff, to_pipe => \$diff_handle);
-    } else {
-	open $diff_handle, $diff or error(_g("can't open diff `%s'"), $diff);
-    }
-    $/ = "\n";
-    $_ = <$diff_handle>;
-
-  HUNK:
-    while (defined($_) || !eof($diff_handle)) {
-	# skip cruft leading up to patch (if any)
-	until (/^--- /) {
-	    last HUNK unless defined ($_ = <$diff_handle>);
-	}
-	# read file header (---/+++ pair)
-	s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff);
-	s/^--- // or
-	    error(_g("expected ^--- in line %d of diff `%s'"), $., $diff);
-	s/\t.*//;
-	$_ eq '/dev/null' or s!^(\./)?[^/]+/!$expectprefix/! or
-	    error(_g("diff `%s' patches file with no subdirectory"), $diff);
-	/\.dpkg-orig$/ and
-	    error(_g("diff `%s' patches file with name ending .dpkg-orig"),
-	          $diff);
-	$fn = $_;
-
-	(defined($_= <$diff_handle>) and s/\n$//) or
-	    error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"),
-	          $diff, $.);
-
-	s/\t.*//;
-	(s/^\+\+\+ // and s!^(\./)?[^/]+/!!) or
-	    error(_g("line after --- isn't as expected in diff `%s' (line %d)"),
-	          $diff, $.);
-
-	if ($fn eq '/dev/null') {
-	    $fn = "$expectprefix/$_";
-	} else {
-	    $_ eq substr($fn, length($expectprefix) + 1) or
-	        error(_g("line after --- isn't as expected in diff `%s' (line %d)"),
-	              $diff, $.);
-	}
-
-	my $dirname = $fn;
-	if ($dirname =~ s,/[^/]+$,, && !defined($dirincluded{$dirname})) {
-	    $dirtocreate{$dirname} = 1;
-	}
-	defined($notfileobject{$fn}) &&
-	    error(_g("diff `%s' patches something which is not a plain file"),
-	          $diff);
-
-	defined($filepatched{$fn}) &&
-	    $filepatched{$fn} eq $diff &&
-	    error(_g("diff patches file %s twice"), $fn);
-	$filepatched{$fn} = $diff;
-
-	# read hunks
-	my $hunk = 0;
-	while (defined($_ = <$diff_handle>) && !(/^--- / or /^Index:/)) {
-	    # read hunk header (@@)
-	    s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff);
-	    next if /^\\ No newline/;
-	    /^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/ or
-		error(_g("Expected ^\@\@ in line %d of diff `%s'"), $., $diff);
-	    my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1);
-	    ++$hunk;
-	    # read hunk
-	    while ($olines || $nlines) {
-		defined($_ = <$diff_handle>) or
-		    error(_g("unexpected end of diff `%s'"), $diff);
-		s/\n$// or
-		    error(_g("diff `%s' is missing trailing newline"), $diff);
-		next if /^\\ No newline/;
-		if (/^ /) { --$olines; --$nlines; }
-		elsif (/^-/) { --$olines; }
-		elsif (/^\+/) { --$nlines; }
-		else {
-		    error(_g("expected [ +-] at start of line %d of diff `%s'"),
-		          $., $diff);
-		}
-	    }
-	}
-	$hunk or error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff);
-    }
-    close($diff_handle);
-    
-    $compressor->wait_end_process() if $diff =~ /\.$comp_regex$/;
-}
-
-sub checktype {
-    my ($dir, $fn, $type) = @_;
-
-    if (!lstat("$dir/$fn")) {
-        &unrepdiff2(_g("nonexistent"),$type{$fn});
-    } else {
-	my $v = eval("$type _ ? 2 : 1");
-	$v || internerr(_g("checktype %s (%s)"), "$@", $type);
-        return 1 if $v == 2;
-        &unrepdiff2(_g("something else"),$type{$fn});
-    }
-    return 0;
-}
 
 sub setopmode {
     defined($opmode) && &usageerr(_g("only one of -x or -b allowed, and only once"));
     $opmode= $_[0];
 }
 
-sub unrepdiff {
-    printf(STDERR _g("%s: cannot represent change to %s: %s")."\n",
-                  $progname, $fn, $_[0])
-        || &syserr(_g("write syserr unrep"));
-    $ur++;
-}
-
-sub unrepdiff2 {
-    printf(STDERR _g("%s: cannot represent change to %s:\n".
-                     "%s:  new version is %s\n".
-                     "%s:  old version is %s\n"),
-                  $progname, $fn, $progname, $_[1], $progname, $_[0])
-        || &syserr(_g("write syserr unrep"));
-    $ur++;
-}
-
 my %added_files;
 sub addfile {
     my ($fields, $filename)= @_;