dpkg-source/3.0 (quilt): improve reliability of check_patches_applied

* scripts/Dpkg/Source/Patch.pm (check_apply): New function to
verify if a patch will successfully apply on top of a given
directory.
* scripts/Dpkg/Source/Package/V3/quilt.pm (check_patches_applied):
Don't trust debian/patches/.dpkg-source-applied blindly. Get a
list of (supposedly unapplied) patches and verify if the first
patch applies or not. If yes, then apply the patch series,
otherwise do not (and assume that the patch series is already
applied).

ChangeLog

@@ -1,3 +1,15 @@
+2008-05-28  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Source/Patch.pm (check_apply): New function to
+	verify if a patch will successfully apply on top of a given
+	directory.
+	* scripts/Dpkg/Source/Package/V3/quilt.pm (check_patches_applied):
+	Don't trust debian/patches/.dpkg-source-applied blindly. Get a
+	list of (supposedly unapplied) patches and verify if the first
+	patch applies or not. If yes, then apply the patch series,
+	otherwise do not (and assume that the patch series is already
+	applied).
+
 2008-05-23  Raphael Hertzog  <hertzog@debian.org>
 
 	* scripts/Dpkg/Source/Package/V2.pm (do_build): Display a

scripts/Dpkg/Source/Package/V3/quilt.pm

@@ -173,8 +173,9 @@ sub prepare_build {
 sub check_patches_applied {
     my ($self, $dir) = @_;
     my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
-    my $quiltdir = File::Spec->catdir($dir, ".pc");
-    if (-d $quiltdir) {
+    my @patches ;
+    # First we try to get a list of patches that could be unapplied
+    if (-x "/usr/bin/quilt") {
         my $auto_patch = $self->get_autopatch_name();
         my $pipe;
         my %opts = (env => { QUILT_PATCHES => 'debian/patches' },
@@ -188,24 +189,18 @@ sub check_patches_applied {
         # quilt... but by the user who made changes live in the tree
         # and whose changes lead to this patch addition by a previous
         # dpkg-source run.
-        my @patches = grep { chomp; $_ ne $auto_patch } (<$pipe>);
+        @patches = grep { chomp; $_ ne $auto_patch } (<$pipe>);
         close ($pipe) || syserr("close on 'quilt unapplied' pipe");
         wait_child($pid, cmdline => "quilt unapplied", nocheck => 1);
-        if (@patches) {
-            warning(_g("patches have not been applied, applying them now (use --no-preparation to override)"));
-            $opts{'wait_child'} = 1;
-            $opts{'to_file'} = "/dev/null";
-            delete $opts{'to_pipe'};
-            foreach my $patch (@patches) {
-                info(_g("applying %s with quilt"), $patch);
-                $opts{'exec'} = [ 'quilt', '--quiltrc', '/dev/null', 'push', $patch ];
-                fork_and_exec(%opts);
-            }
-        }
-        return;
+    } else {
+        @patches = $self->get_patches($dir);
     }
-    unless (-e $applied) {
-        if (scalar($self->get_patches($dir))) {
+    # Then we check if it's applicable, and if yes, we make the
+    # assumption that patches are not applied and need to be applied
+    if (scalar(@patches)) {
+        my $first_patch = File::Spec->catfile($dir, "debian", "patches", $patches[0]);
+        my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch);
+        if ($patch_obj->check_apply($dir)) {
             warning(_g("patches have not been applied, applying them now (use --no-preparation to override)"));
             $self->apply_patches($dir);
         }

scripts/Dpkg/Source/Patch.pm

@@ -377,6 +377,16 @@ sub analyze {
     return $self->{'analysis'}{$destdir};
 }
 
+sub prepare_apply {
+    my ($self, $analysis, %opts) = @_;
+    if ($opts{"create_dirs"}) {
+	foreach my $dir (keys %{$analysis->{'dirtocreate'}}) {
+	    eval { mkpath($dir, 0, 0777); };
+	    syserr(_g("cannot create directory %s"), $dir) if $@;
+	}
+    }
+}
+
 sub apply {
     my ($self, $destdir, %opts) = @_;
     # Set default values to options
@@ -389,12 +399,7 @@ sub apply {
     push @{$opts{"options"}}, @{$opts{"add_options"}};
     # 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 $@;
-	}
-    }
+    $self->prepare_apply($analysis, %opts);
     # Apply the patch
     my $diff_handle = $self->open_for_read();
     fork_and_exec(
@@ -421,6 +426,37 @@ sub apply {
     }
 }
 
+# Verify if check will work...
+sub check_apply {
+    my ($self, $destdir, %opts) = @_;
+    # Set default values to options
+    $opts{"create_dirs"} = 1 unless exists $opts{"create_dirs"};
+    $opts{"options"} ||= [ '--dry-run', '-s', '-t', '-F', '0', '-N', '-p1', '-u',
+            '-V', 'never', '-g0', '-b', '-z', '.dpkg-orig'];
+    $opts{"add_options"} ||= [];
+    push @{$opts{"options"}}, @{$opts{"add_options"}};
+    # Check the diff and create missing directories
+    my $analysis = $self->analyze($destdir, %opts);
+    $self->prepare_apply($analysis, %opts);
+    # Apply the patch
+    my $diff_handle = $self->open_for_read();
+    my $error;
+    my $patch_pid = fork_and_exec(
+	'exec' => [ 'patch', @{$opts{"options"}} ],
+	'chdir' => $destdir,
+	'env' => { LC_ALL => 'C', LANG => 'C' },
+	'delete_env' => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour
+	'from_handle' => $diff_handle,
+        'to_file' => '/dev/null',
+        'error_to_file' => '/dev/null',
+    );
+    wait_child($patch_pid, nocheck => 1);
+    my $exit = WEXITSTATUS($?);
+    subprocerr("patch --dry-run") unless WIFEXITED($?);
+    $self->cleanup_after_open();
+    return ($exit == 0);
+}
+
 # Helper functions
 sub get_type {
     my $file = shift;