summaryrefslogtreecommitdiff
path: root/scripts/Dpkg
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/Dpkg')
-rw-r--r--scripts/Dpkg/Compression.pm133
-rw-r--r--scripts/Dpkg/Compression/CompressedFile.pm7
-rw-r--r--scripts/Dpkg/Compression/Compressor.pm8
-rw-r--r--scripts/Dpkg/Source/Package.pm5
-rw-r--r--scripts/Dpkg/Source/Package/V1.pm2
-rw-r--r--scripts/Dpkg/Source/Package/V2.pm15
-rw-r--r--scripts/Dpkg/Source/Package/V3/bzr.pm4
-rw-r--r--scripts/Dpkg/Source/Package/V3/git.pm4
-rw-r--r--scripts/Dpkg/Source/Package/V3/native.pm4
9 files changed, 143 insertions, 39 deletions
diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm
index f858c9db6..7c9d16149 100644
--- a/scripts/Dpkg/Compression.pm
+++ b/scripts/Dpkg/Compression.pm
@@ -1,3 +1,5 @@
+# Copyright © 2010 Raphaël Hertzog <hertzog@debian.org>
+#
# 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
@@ -17,27 +19,126 @@ use strict;
use warnings;
use base qw(Exporter);
-our @EXPORT = qw(@comp_supported %comp_supported %comp_ext $comp_regex
- %comp_prog %comp_decomp_prog
- get_compression_from_filename);
-
-our @comp_supported = qw(gzip bzip2 lzma xz);
-our %comp_supported = map { $_ => 1 } @comp_supported;
-our %comp_ext = (gzip => 'gz', bzip2 => 'bz2', lzma => 'lzma', xz => 'xz');
-our $comp_regex = '(?:gz|bz2|lzma|xz)';
-our %comp_prog = (gzip => 'gzip', bzip2 => 'bzip2', lzma => 'lzma',
- xz => 'xz');
-our %comp_decomp_prog = (gzip => 'gunzip', bzip2 => 'bunzip2', lzma => 'unlzma',
- xz => 'unxz');
-
-sub get_compression_from_filename {
+our @EXPORT = qw($compression_re_file_ext compression_get_list
+ compression_is_supported compression_get_property
+ compression_guess_from_filename);
+
+=head1 NAME
+
+Dpkg::Compression - simple database of available compression methods
+
+=head1 DESCRIPTION
+
+This modules provides a few public funcions and a public regex to
+interact with the set of supported compression methods.
+
+=head1 EXPORTED VARIABLES
+
+=over 4
+
+=cut
+
+my $COMP = {
+ "gzip" => {
+ "file_ext" => "gz",
+ "comp_prog" => "gzip",
+ "decomp_prog" => "gunzip",
+ },
+ "bzip2" => {
+ "file_ext" => "bz2",
+ "comp_prog" => "bzip2",
+ "decomp_prog" => "bunzip2",
+ },
+ "lzma" => {
+ "file_ext" => "lzma",
+ "comp_prog" => "lzma",
+ "decomp_prog" => "unlzma",
+ },
+ "xz" => {
+ "file_ext" => "xz",
+ "comp_prog" => "xz",
+ "decomp_prog" => "unxz",
+ },
+};
+
+=item $compression_re_file_ext
+
+A regex that matches a file extension of a file compressed with one of the
+supported compression methods.
+
+=back
+
+=cut
+
+my $regex = join "|", map { $_->{"file_ext"} } values %$COMP;
+our $compression_re_file_ext = qr/(?:$regex)/;
+
+=head1 EXPORTED FUNCTIONS
+
+=over 4
+
+=item my @list = compression_get_list()
+
+Returns a list of supported compression methods (sorted alphabetically).
+
+=cut
+
+sub compression_get_list {
+ return sort keys %$COMP;
+}
+
+=item compression_is_supported($comp)
+
+Returns a boolean indicating whether the give compression method is
+known and supported.
+
+=cut
+
+sub compression_is_supported {
+ return exists $COMP->{$_[0]};
+}
+
+=item compression_get_property($comp, $property)
+
+Returns the requested property of the compression method. Returns undef if
+either the property or the compression method doesn't exist. Valid
+properties currently include "file_ext" for the file extension,
+"comp_prog" for the name of the compression program and "decomp_prog" for
+the name of the decompression program.
+
+=cut
+
+sub compression_get_property {
+ my ($comp, $property) = @_;
+ return undef unless compression_is_supported($comp);
+ return $COMP->{$comp}{$property} if exists $COMP->{$comp}{$property};
+ return undef;
+}
+
+=item compression_guess_from_filename($filename)
+
+Returns the compression method that is likely used on the indicated
+filename based on its file extension.
+
+=cut
+
+sub compression_guess_from_filename {
my $filename = shift;
- foreach my $comp (@comp_supported) {
- if ($filename =~ /^(.*)\.\Q$comp_ext{$comp}\E$/) {
+ foreach my $comp (compression_get_list()) {
+ my $ext = compression_get_property($comp, "file_ext");
+ if ($filename =~ /^(.*)\.\Q$ext\E$/) {
return $comp;
}
}
return undef;
}
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog@debian.org>.
+
+=cut
+
1;
diff --git a/scripts/Dpkg/Compression/CompressedFile.pm b/scripts/Dpkg/Compression/CompressedFile.pm
index 1a85ba059..ffa471eb9 100644
--- a/scripts/Dpkg/Compression/CompressedFile.pm
+++ b/scripts/Dpkg/Compression/CompressedFile.pm
@@ -291,7 +291,7 @@ sub set_filename {
if (defined($add_comp_ext)) {
*$self->{"add_comp_ext"} = $add_comp_ext;
}
- if (*$self->{"add_comp_ext"} and $filename =~ /\.$comp_regex$/) {
+ if (*$self->{"add_comp_ext"} and $filename =~ /\.$compression_re_file_ext$/) {
warning("filename %s already has an extension of a compressed file " .
"and add_comp_ext is active", $filename);
}
@@ -317,7 +317,8 @@ sub get_filename {
} elsif ($comp eq "none") {
return *$self->{"filename"};
} else {
- return *$self->{"filename"} . "." . $comp_ext{$comp};
+ return *$self->{"filename"} . "." .
+ compression_get_property($comp, "file_ext");
}
} else {
return *$self->{"filename"};
@@ -339,7 +340,7 @@ sub use_compression {
if ($comp eq "none") {
return 0;
} elsif ($comp eq "auto") {
- $comp = get_compression_from_filename($self->get_filename());
+ $comp = compression_guess_from_filename($self->get_filename());
*$self->{"compressor"}->set_compression($comp) if $comp;
}
return $comp;
diff --git a/scripts/Dpkg/Compression/Compressor.pm b/scripts/Dpkg/Compression/Compressor.pm
index 4ca4ff454..4da35a129 100644
--- a/scripts/Dpkg/Compression/Compressor.pm
+++ b/scripts/Dpkg/Compression/Compressor.pm
@@ -32,7 +32,7 @@ our $default_compression_level = 9;
sub set_default_compression {
my ($self, $method) = @_;
error(_g("%s is not a supported compression"), $method)
- unless $comp_supported{$method};
+ unless compression_is_supported($method);
$default_compression = $method;
}
@@ -58,7 +58,7 @@ sub new {
sub set_compression {
my ($self, $method) = @_;
error(_g("%s is not a supported compression method"), $method)
- unless $comp_supported{$method};
+ unless compression_is_supported($method);
$self->{"compression"} = $method;
}
@@ -71,7 +71,7 @@ sub set_compression_level {
sub get_compress_cmdline {
my ($self) = @_;
- my @prog = ($comp_prog{$self->{"compression"}});
+ my @prog = (compression_get_property($self->{"compression"}, "comp_prog"));
my $level = "-" . $self->{"compression_level"};
$level = "--" . $self->{"compression_level"}
if $self->{"compression_level"} =~ m/best|fast/;
@@ -81,7 +81,7 @@ sub get_compress_cmdline {
sub get_uncompress_cmdline {
my ($self) = @_;
- return ($comp_decomp_prog{$self->{"compression"}});
+ return (compression_get_property($self->{"compression"}, "decomp_prog"));
}
sub _sanity_check {
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index 902b152c6..4d8351def 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -242,7 +242,7 @@ sub get_basename {
sub find_original_tarballs {
my ($self, $ext) = @_;
- $ext ||= $comp_regex;
+ $ext ||= $compression_re_file_ext;
my $basename = $self->get_basename();
my @tar;
foreach my $dir (".", $self->{'basedir'}, $self->{'options'}{'origtardir'}) {
@@ -332,7 +332,8 @@ sub extract {
my $basename = $self->get_basename();
my ($dirname, $destdir) = fileparse($newdirectory);
$destdir ||= "./";
- foreach my $orig (grep { /^\Q$basename\E\.orig(-\w+)?\.tar\.$comp_regex$/ }
+ my $ext = $compression_re_file_ext;
+ foreach my $orig (grep { /^\Q$basename\E\.orig(-\w+)?\.tar\.$ext$/ }
$self->get_files())
{
my $src = File::Spec->catfile($self->{'basedir'}, $orig);
diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm
index a7e81327d..319e9c290 100644
--- a/scripts/Dpkg/Source/Package/V1.pm
+++ b/scripts/Dpkg/Source/Package/V1.pm
@@ -292,7 +292,7 @@ sub do_build {
my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
DIR => getcwd(), UNLINK => 0);
my $tar = Dpkg::Source::Archive->new(filename => $newtar,
- compression => get_compression_from_filename($tarname),
+ compression => compression_guess_from_filename($tarname),
compression_level => $self->{'options'}{'comp_level'});
$tar->create(options => \@tar_ignore, 'chdir' => $tardirbase);
$tar->add_directory($tardirname);
diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm
index 2a8f7e966..bcacea887 100644
--- a/scripts/Dpkg/Source/Package/V2.pm
+++ b/scripts/Dpkg/Source/Package/V2.pm
@@ -89,16 +89,17 @@ sub do_extract {
my $basenamerev = $self->get_basename(1);
my ($tarfile, $debianfile, %origtar, %seen);
+ my $re_ext = $compression_re_file_ext;
foreach my $file ($self->get_files()) {
- (my $uncompressed = $file) =~ s/\.$comp_regex$//;
+ (my $uncompressed = $file) =~ s/\.$re_ext$//;
error(_g("duplicate files in %s source package: %s.*"), "v2.0",
$uncompressed) if $seen{$uncompressed};
$seen{$uncompressed} = 1;
- if ($file =~ /^\Q$basename\E\.orig\.tar\.$comp_regex$/) {
+ if ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext$/) {
$tarfile = $file;
- } elsif ($file =~ /^\Q$basename\E\.orig-([\w-]+)\.tar\.$comp_regex$/) {
+ } elsif ($file =~ /^\Q$basename\E\.orig-([\w-]+)\.tar\.$re_ext$/) {
$origtar{$1} = $file;
- } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$comp_regex$/) {
+ } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$re_ext$/) {
$debianfile = $file;
} else {
error(_g("unrecognized file for a %s source package: %s"),
@@ -201,7 +202,7 @@ sub apply_patches {
sub can_build {
my ($self, $dir) = @_;
foreach ($self->find_original_tarballs()) {
- return 1 if /\.orig\.tar\.$comp_regex$/;
+ return 1 if /\.orig\.tar\.$compression_re_file_ext$/;
}
return (0, _g("no orig.tar file found"));
}
@@ -250,7 +251,7 @@ sub do_build {
my ($tarfile, %origtar);
my @origtarballs;
foreach (sort $self->find_original_tarballs()) {
- if (/\.orig\.tar\.$comp_regex$/) {
+ if (/\.orig\.tar\.$compression_re_file_ext$/) {
if (defined($tarfile)) {
error(_g("several orig.tar files found (%s and %s) but only " .
"one is allowed"), $tarfile, $_);
@@ -258,7 +259,7 @@ sub do_build {
$tarfile = $_;
push @origtarballs, $_;
$self->add_file($_);
- } elsif (/\.orig-([\w-]+)\.tar\.$comp_regex$/) {
+ } elsif (/\.orig-([\w-]+)\.tar\.$compression_re_file_ext$/) {
$origtar{$1} = $_;
push @origtarballs, $_;
$self->add_file($_);
diff --git a/scripts/Dpkg/Source/Package/V3/bzr.pm b/scripts/Dpkg/Source/Package/V3/bzr.pm
index b30c17a8e..dd5d1444c 100644
--- a/scripts/Dpkg/Source/Package/V3/bzr.pm
+++ b/scripts/Dpkg/Source/Package/V3/bzr.pm
@@ -177,9 +177,9 @@ sub do_extract {
error(_g("format v3.0 uses only one source file"));
}
my $tarfile = $files[0];
- if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$comp_regex$/) {
+ if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$compression_re_file_ext$/) {
error(_g("expected %s, got %s"),
- "$basenamerev.bzr.tar.$comp_regex", $tarfile);
+ "$basenamerev.bzr.tar.$compression_re_file_ext", $tarfile);
}
erasedir($newdirectory);
diff --git a/scripts/Dpkg/Source/Package/V3/git.pm b/scripts/Dpkg/Source/Package/V3/git.pm
index a2dd1335d..d3b72a983 100644
--- a/scripts/Dpkg/Source/Package/V3/git.pm
+++ b/scripts/Dpkg/Source/Package/V3/git.pm
@@ -241,9 +241,9 @@ sub do_extract {
error(_g("format v3.0 uses only one source file"));
}
my $tarfile = $files[0];
- if ($tarfile !~ /^\Q$basenamerev\E\.git\.tar\.$comp_regex$/) {
+ if ($tarfile !~ /^\Q$basenamerev\E\.git\.tar\.$compression_re_file_ext$/) {
error(_g("expected %s, got %s"),
- "$basenamerev.git.tar.$comp_regex", $tarfile);
+ "$basenamerev.git.tar.$compression_re_file_ext", $tarfile);
}
erasedir($newdirectory);
diff --git a/scripts/Dpkg/Source/Package/V3/native.pm b/scripts/Dpkg/Source/Package/V3/native.pm
index a0c1b20ce..189b8d6ab 100644
--- a/scripts/Dpkg/Source/Package/V3/native.pm
+++ b/scripts/Dpkg/Source/Package/V3/native.pm
@@ -44,7 +44,7 @@ sub do_extract {
my $tarfile;
foreach my $file ($self->get_files()) {
- if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_regex$/) {
+ if ($file =~ /^\Q$basenamerev\E\.tar\.$compression_re_file_ext$/) {
error(_g("multiple tarfiles in v1.0 source package")) if $tarfile;
$tarfile = $file;
} else {
@@ -85,7 +85,7 @@ sub do_build {
my ($dirname, $dirbase) = fileparse($dir);
my $tar = Dpkg::Source::Archive->new(filename => $newtar,
- compression => get_compression_from_filename($tarname),
+ compression => compression_guess_from_filename($tarname),
compression_level => $self->{'options'}{'comp_level'});
$tar->create(options => \@tar_ignore, 'chdir' => $dirbase);
$tar->add_directory($dirname);
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-16 10:02:48 +0000