dpkg-source: factorize logic of copy of original tarballs

* scripts/Dpkg/Source/Package.pm (extract): Now handles copy
of original tarballs and addition of executable right to
debian/rules.
scripts/Dpkg/Source/Package/V1_0.pm (do_extract, parse_cmdline_option):
Don't copy the original tarball as it's already done by extract().
* scripts/dpkg-source.pl: New option --no-copy to not copy
the original tarballs. New option --no-check to not check signature
and checksum. Misc cleanup in the options handling code.

scripts/Dpkg/Source/Package.pm

@@ -28,7 +28,9 @@ use Dpkg::Version qw(parseversion);
 use Dpkg::Deps qw(@src_dep_fields);
 use Dpkg::Compression;
 use Dpkg::Exit;
+use Dpkg::Path qw(check_files_are_the_same);
 
+use POSIX;
 use File::Basename;
 
 my @dsc_fields = (qw(Format Source Binary Architecture Version Origin
@@ -236,11 +238,46 @@ sub parse_cmdline_option {
 
 sub extract {
     my $self = shift;
+    my $newdirectory = $_[0];
+
+    # Copy orig tarballs
+    if ($self->{'options'}{'copy_orig_tarballs'}) {
+        my $basename = $self->get_basename();
+        my ($dirname, $destdir) = fileparse($newdirectory);
+        $destdir ||= "./";
+        foreach my $orig (grep { /^\Q$basename\E\.orig(-\w+)?\.tar\.$comp_regex$/ }
+                          $self->get_files())
+        {
+            my $src = File::Spec->catfile($self->{'basedir'}, $orig);
+            my $dst = File::Spec->catfile($destdir, $orig);
+            if (not check_files_are_the_same($src, $dst)) {
+                system('cp', '--', $src, $dst);
+                subprocerr("cp $src to $dst") if $?;
+            }
+        }
+    }
+
+    # Try extract
     eval { $self->do_extract(@_) };
     if ($@) {
         &$_() foreach reverse @Dpkg::Exit::handlers;
         die $@;
     }
+
+    # Make sure debian/rules is executable
+    my $rules = File::Spec->catfile($newdirectory, "debian", "rules");
+    my @s = lstat($rules);
+    if (not scalar(@s)) {
+        unless ($! == ENOENT) {
+            syserr(_g("cannot stat %s"), $rules);
+        }
+        warning(_g("%s does not exist"), $rules);
+    } elsif (-f _) {
+        chmod($s[2] | 0111, $rules) ||
+            syserr(_g("cannot make %s executable"), $rules);
+    } else {
+        warning(_g("%s is not a plain file"), $rules);
+    }
 }
 
 sub do_extract {

scripts/Dpkg/Source/Package/V1_0.pm

@@ -50,6 +50,7 @@ sub parse_cmdline_option {
         warning(_g("-s%s option overrides earlier -s%s option"), $1,
                 $o->{'sourcestyle'}) if $o->{'sourcestyle'} ne 'X';
         $o->{'sourcestyle'} = $1;
+        $o->{'copy_orig_tarballs'} = 0 if $1 eq 'n'; # Extract option -sn
         return 1;
     }
     return 0;
@@ -110,13 +111,7 @@ sub do_extract {
         my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
         $tar->extract($expectprefix);
 
-        if ($sourcestyle =~ /p/) {
-            # -sp: copy the .orig.tar.gz if required
-            if (not check_files_are_the_same("$dscdir$tarfile", $tarfile)) {
-                system('cp', '--', "$dscdir$tarfile", $tarfile);
-                subprocerr("cp $dscdir$tarfile to $tarfile") if $?;
-            }
-        } elsif ($sourcestyle =~ /u/) {
+        if ($sourcestyle =~ /u/) {
             # -su: keep .orig directory unpacked
             if (-e "$newdirectory.tmp-keep") {
                 error(_g("unable to keep orig directory (already exists)"));

scripts/dpkg-source.pl

@@ -6,9 +6,8 @@ use warnings;
 
 use Dpkg;
 use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(warning warnerror error failure unknown
-                           internerr syserr subprocerr usageerr info
-                           $warnable_error $quiet_warnings);
+use Dpkg::ErrorHandling qw(warning error unknown syserr usageerr info
+                           $quiet_warnings);
 use Dpkg::Arch qw(debarch_eq);
 use Dpkg::Deps qw(@src_dep_fields %dep_field_type);
 use Dpkg::Fields qw(:list capit);
@@ -21,7 +20,6 @@ use Dpkg::Changelog qw(parse_changelog);
 use Dpkg::Source::Compressor;
 use Dpkg::Source::Package;
 
-use POSIX;
 use English;
 use File::Spec;
 
@@ -91,6 +89,9 @@ my %options = (
     # Ignore files
     tar_ignore => [],
     diff_ignore_regexp => '',
+    # Misc options
+    copy_orig_tarballs => 1,
+    no_check => 0,
 );
 
 # Fields to remove/override
@@ -98,7 +99,6 @@ my %remove;
 my %override;
 
 my $substvars = Dpkg::Substvars->new();
-my $opmode;
 my $tar_ignore_default_pattern_done;
 
 my @cmdline_options;
@@ -143,6 +143,10 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
             # Prevent adding multiple times
             $tar_ignore_default_pattern_done = 1;
         }
+    } elsif (m/^--no-copy$/) {
+        $options{'copy_orig_tarballs'} = 0;
+    } elsif (m/^--no-check$/) {
+        $options{'no_check'} = 1;
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
         $substvars->set($1, $POSTMATCH);
         warning(_g("substvars support is deprecated (see README.feature-removal-schedule)"));
@@ -155,12 +159,12 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     } elsif (m/^--version$/) {
         version();
         exit(0);
-    } elsif (m/^-W$/) {
-        $warnable_error = 1;
-    } elsif (m/^-E$/) {
-        $warnable_error = 0;
+    } elsif (m/^-[EW]$/) {
+        # Deprecated option
+        warning(_g("-E and -W are deprecated, they are without effect"));
     } elsif (m/^-q$/) {
         $quiet_warnings = 1;
+        $options{'quiet'} = 1;
     } elsif (m/^--$/) {
         last;
     } else {
@@ -168,11 +172,11 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     }
 }
 
-unless (defined($opmode)) {
+unless (defined($options{'opmode'})) {
     usageerr(_g("need -x or -b"));
 }
 
-if ($opmode eq 'build') {
+if ($options{'opmode'} eq 'build') {
 
     if (not scalar(@ARGV)) {
 	usageerr(_g("-b needs a directory"));
@@ -321,7 +325,7 @@ if ($opmode eq 'build') {
 		       substvars => $substvars);
     exit(0);
 
-} elsif ($opmode eq 'extract') {
+} elsif ($options{'opmode'} eq 'extract') {
 
     # Check command line
     unless (scalar(@ARGV)) {
@@ -353,39 +357,27 @@ if ($opmode eq 'build') {
     }
 
     # Various checks before unpacking
-    if ($srcpkg->is_signed()) {
-	$srcpkg->check_signature();
-    } else {
-	warning(_g("extracting unsigned source package (%s)"), $dsc);
+    unless ($options{'no_check'}) {
+        if ($srcpkg->is_signed()) {
+            $srcpkg->check_signature();
+        } else {
+            warning(_g("extracting unsigned source package (%s)"), $dsc);
+        }
+        $srcpkg->check_checksums();
     }
-    $srcpkg->check_checksums();
 
     # Unpack the source package (delegated to Dpkg::Source::Package::*)
     info(_g("extracting %s in %s"), $srcpkg->{'fields'}{'Source'}, $newdirectory);
     $srcpkg->extract($newdirectory);
 
-    # Make sure debian/rules is executable
-    my @s = lstat("$newdirectory/debian/rules");
-    if (not scalar(@s)) {
-	unless ($! == ENOENT) {
-	    syserr(_g("cannot stat %s"), "$newdirectory/debian/rules");
-	}
-	warning(_g("%s does not exist"), "$newdirectory/debian/rules");
-    } elsif (-f _) {
-	chmod($s[2] | 0111, "$newdirectory/debian/rules") ||
-	    syserr(_g("cannot make %s executable"), "$newdirectory/debian/rules");
-    } else {
-	warning(_g("%s is not a plain file"), "$newdirectory/debian/rules");
-    }
-
     exit(0);
 }
 
 sub setopmode {
-    if (defined($opmode)) {
+    if (defined($options{'opmode'})) {
 	usageerr(_g("only one of -x or -b allowed, and only once"));
     }
-    $opmode = $_[0];
+    $options{'opmode'} = $_[0];
 }
 
 sub version {
@@ -419,9 +411,7 @@ Build options:
   -T<varlistfile>          read variables here, not debian/substvars.
   -D<field>=<value>        override or add a .dsc field and value.
   -U<field>                remove a field.
-  -E                       turn certain warnings into errors.
-  -W                       when -E is enabled, -W disables it.
-  -q                       quiet operation, do not print warnings.
+  -q                       quiet mode.
   -i[<regexp>]             filter out files to ignore diffs of
                              (defaults to: '%s').
   -I[<pattern>]            filter out files when building tarballs
@@ -431,6 +421,11 @@ Build options:
   -z<level>                compression level to use (defaults to '9',
                              supported are: '1'-'9', 'best', 'fast')
 
+Extract options:
+  --no-copy                don't copy .orig tarballs
+  --no-check               don't check signature and checksums before
+                             unpacking
+
 General options:
   -h, --help               show this help message.
       --version            show the version.