From: Raphael Hertzog Date: Fri, 29 Feb 2008 22:27:30 +0000 (+0100) Subject: Create Dpkg::Source::Package::V1_0::native X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d3b6e4bca1dc499c61a177c72e6facdd3c0d9efa;p=dpkg Create Dpkg::Source::Package::V1_0::native * scripts/Dpkg/Source/Package/V1_0/native.pm: New module that handles native source packages with any compression. * scripts/Dpkg/Source/Package/V1_0.pm: Adjusted to use the previous module when it comes to handle native packages. Simplified several other code paths. * scripts/Makefile.am, scripts/po/POTFILES.in: Add the new module. * scripts/dpkg-source.pl: Add the new format as fallback to try when building a source package. It will likely only be selected when non-gzip compression has been requested. --- diff --git a/scripts/Dpkg/Source/Package/V1_0.pm b/scripts/Dpkg/Source/Package/V1_0.pm index 7a0da845..46ea4b1d 100644 --- a/scripts/Dpkg/Source/Package/V1_0.pm +++ b/scripts/Dpkg/Source/Package/V1_0.pm @@ -30,10 +30,13 @@ use Dpkg::Source::Patch; use Dpkg::Version qw(check_version); use Dpkg::Exit; use Dpkg::Source::Functions qw(erasedir); +use Dpkg::Source::Package::V1_0::native; +use Dpkg::Path qw(check_files_are_the_same); use POSIX; use File::Basename; use File::Temp qw(tempfile); +use File::Spec; sub do_extract { my ($self, $newdirectory) = @_; @@ -68,69 +71,43 @@ sub do_extract { error(_g("no tarfile in Files field")) unless $tarfile; my $native = $difffile ? 0 : 1; - if ($native) { - warning(_g("native package with .orig.tar")) - if $tarfile =~ /\.orig\.tar\.gz$/; - } else { - warning(_g("no upstream tarfile in Files field")) - unless defined $tarfile; + if ($native and ($tarfile =~ /\.orig\.tar\.gz$/)) { + warning(_g("native package with .orig.tar")); + $native = 0; # V1_0::native doesn't handle orig.tar } - my $expectprefix = $newdirectory; - $expectprefix .= '.orig' if $difffile; - - erasedir($newdirectory); - if (-e $expectprefix) { - rename($expectprefix, "$newdirectory.tmp-keep") || - syserr(_g("unable to rename `%s' to `%s'"), $expectprefix, - "$newdirectory.tmp-keep"); - } + if ($native) { + Dpkg::Source::Package::V1_0::native::do_extract($self, $newdirectory); + } else { + my $expectprefix = $newdirectory; + $expectprefix .= '.orig'; + + erasedir($newdirectory); + if (-e $expectprefix) { + rename($expectprefix, "$newdirectory.tmp-keep") || + syserr(_g("unable to rename `%s' to `%s'"), $expectprefix, + "$newdirectory.tmp-keep"); + } - info(_g("unpacking %s"), $tarfile); - my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); - $tar->extract($expectprefix); + info(_g("unpacking %s"), $tarfile); + my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); + $tar->extract($expectprefix); - # for the first tar file: - if ($tarfile and not $native) - { - # -sp: copy the .orig.tar.gz if required if ($sourcestyle =~ /p/) { - stat("$dscdir$tarfile") || - syserr(_g("failed to stat `%s' to see if need to copy"), - "$dscdir$tarfile"); - - my ($dsctardev, $dsctarino) = stat _; - my $copy_required; - - if (stat($tarfile)) { - my ($dumptardev, $dumptarino) = stat _; - $copy_required = ($dumptardev != $dsctardev || - $dumptarino != $dsctarino); - } else { - unless ($! == ENOENT) { - syserr(_g("failed to check destination `%s' " . - "to see if need to copy"), $tarfile); - } - $copy_required = 1; - } - - if ($copy_required) { + # -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 $?; } - } - # -su: keep .orig directory unpacked - elsif ($sourcestyle =~ /u/ and $expectprefix ne $newdirectory) { + } elsif ($sourcestyle =~ /u/) { + # -su: keep .orig directory unpacked if (-e "$newdirectory.tmp-keep") { error(_g("unable to keep orig directory (already exists)")); } system('cp', '-ar', '--', $expectprefix, "$newdirectory.tmp-keep"); subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?; } - } - if ($newdirectory ne $expectprefix) - { rename($expectprefix, $newdirectory) || syserr(_g("failed to rename newly-extracted %s to %s"), $expectprefix, $newdirectory); @@ -145,7 +122,7 @@ sub do_extract { if ($difffile) { my $patch = "$dscdir$difffile"; - info(_g("applying %s"), $patch); + info(_g("applying %s"), $difffile); my $patch_obj = Dpkg::Source::Patch->new(filename => $patch); $patch_obj->apply($newdirectory, force_timestamp => 1, timestamp => time()); @@ -167,8 +144,6 @@ sub do_build { my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; my $diff_ignore_regexp = $self->{'options'}{'diff_ignore_regexp'}; - $dir =~ s{/+$}{}; # Strip trailing / - if (scalar(@argv) > 1) { usageerr(_g("-b takes at most a directory and an orig source ". "argument (with v1.0 source package)")); @@ -177,7 +152,7 @@ sub do_build { $sourcestyle =~ y/X/A/; unless ($sourcestyle =~ m/[akpursnAKPUR]/) { usageerr(_g("source handling style -s%s not allowed with -b"), - $sourcestyle); + $sourcestyle); } my $sourcepackage = $self->{'fields'}{'Source'}; @@ -205,8 +180,7 @@ sub do_build { stat($origarg) || syserr(_g("cannot stat orig argument %s"), $origarg); if (-d _) { - $origdir = $origarg; - $origdir =~ s{/*$}{}; + $origdir = File::Spec->catdir($origarg); $sourcestyle =~ y/aA/rR/; unless ($sourcestyle =~ m/[ursURS]/) { @@ -277,13 +251,11 @@ sub do_build { ".orig.tar (wanted %s)"), $tarname, "$basename.orig.tar.gz"); } - } else { - $tardirbase = $dirbase; - $tardirname = $dirname; - $tarname = "$basenamerev.tar.gz"; } - if ($sourcestyle =~ m/[nurUR]/) { + if ($sourcestyle eq "n") { + Dpkg::Source::Package::V1_0::native::build($self, $dir); + } elsif ($sourcestyle =~ m/[nurUR]/) { if (stat($tarname)) { unless ($sourcestyle =~ m/[nUR]/) { error(_g("tarfile `%s' already exists, not overwriting, " . @@ -343,7 +315,7 @@ sub do_build { my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX", DIR => getcwd(), UNLINK => 0); my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz, - compression => get_compression_from_filename($diffname)); + compression => "gzip"); $diff->create(); $diff->add_diff_directory($origdir, $dir, basedirname => $basedirname, diff --git a/scripts/Dpkg/Source/Package/V1_0/native.pm b/scripts/Dpkg/Source/Package/V1_0/native.pm new file mode 100644 index 00000000..2b7c2c9c --- /dev/null +++ b/scripts/Dpkg/Source/Package/V1_0/native.pm @@ -0,0 +1,100 @@ +# Copyright 2008 Raphaël Hertzog + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. + +# 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 the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +package Dpkg::Source::Package::V1_0::native; + +use strict; +use warnings; + +use base 'Dpkg::Source::Package'; + +use Dpkg; +use Dpkg::Gettext; +use Dpkg::ErrorHandling qw(error syserr info); +use Dpkg::Compression; +use Dpkg::Source::Archive; +use Dpkg::Source::Functions qw(erasedir); + +use POSIX; +use File::Basename; +use File::Temp qw(tempfile); + +sub do_extract { + my ($self, $newdirectory) = @_; + my $sourcestyle = $self->{'options'}{'sourcestyle'}; + my $fields = $self->{'fields'}; + + my $dscdir = $self->{'basedir'}; + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + my $tarfile; + foreach my $file ($self->get_files()) { + if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_regex$/) { + error(_g("multiple tarfiles in v1.0 source package")) if $tarfile; + $tarfile = $file; + } else { + error(_g("unrecognized file for a native source package: %s"), $file); + } + } + + error(_g("no tarfile in Files field")) unless $tarfile; + + erasedir($newdirectory); + info(_g("unpacking %s"), $tarfile); + my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); + $tar->extract($newdirectory); +} + +sub can_build { + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; + + my $sourcepackage = $self->{'fields'}{'Source'}; + my $basenamerev = $self->get_basename(1); + my $tarname = "$basenamerev.tar." . $self->{'options'}{'comp_ext'}; + + info(_g("building %s in %s"), $sourcepackage, $tarname); + + my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX", + DIR => getcwd(), UNLINK => 0); + + my ($dirname, $dirbase) = fileparse($dir); + my $tar = Dpkg::Source::Archive->new(filename => $newtar, + compression => get_compression_from_filename($tarname), + compression_level => $self->{'options'}{'comp_level'}); + $tar->create(options => \@tar_ignore, 'chdir' => $dirbase); + $tar->add_directory($dirname); + $tar->finish(); + rename($newtar, $tarname) || + syserr(_g("unable to rename `%s' (newly created) to `%s'"), + $newtar, $tarname); + + $self->add_file($tarname); + + if ($self->{'options'}{'compression'} eq "gzip") { + $self->{'fields'}{'Format'} = "1.0"; + } else { + $self->{'fields'}{'Format'} = "1.0 (native)"; + } +} + +# vim: set et sw=4 ts=8 +1; diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 59cd221e..221c24b4 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -112,6 +112,7 @@ nobase_dist_perllib_DATA = \ Dpkg/Source/Functions.pm \ Dpkg/Source/Package.pm \ Dpkg/Source/Package/V1_0.pm \ + Dpkg/Source/Package/V1_0/native.pm \ Dpkg/Source/Package/V2_0.pm \ Dpkg/Source/Patch.pm \ Dpkg/Source/VCS/git.pm \ diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index b16aa0b7..c7902785 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -82,7 +82,7 @@ _darcs {arch} ); -my @build_formats = ("1.0"); +my @build_formats = ("1.0", "1.0 (native)"); my %options = ( # Compression related compression => 'gzip', diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in index 7f98c99e..30ed975c 100644 --- a/scripts/po/POTFILES.in +++ b/scripts/po/POTFILES.in @@ -34,6 +34,7 @@ scripts/Dpkg/Source/Functions.pm scripts/Dpkg/Source/Patch.pm scripts/Dpkg/Source/Package.pm scripts/Dpkg/Source/Package/V1_0.pm +scripts/Dpkg/Source/Package/V1_0/native.pm scripts/Dpkg/Source/Package/V2_0.pm scripts/Dpkg/Source/Package/V3_0/git.pm scripts/Dpkg/Substvars.pm