[devscripts] 03/04: mk-origtargz: Remove use of Text::Glob
James McCoy
jamessan at debian.org
Sun May 4 01:43:39 UTC 2014
This is an automated email from the git hooks/post-receive script.
jamessan pushed a commit to branch master
in repository devscripts.
commit d7f603e2e15257be0c539a1f62b097f3a2109892
Author: James McCoy <jamessan at debian.org>
Date: Thu Apr 24 00:05:20 2014 -0400
mk-origtargz: Remove use of Text::Glob
Text::Glob expands the shell metacharacters {} and [], which are
explicitly not handled according to copyright-format-1.0. Instead of
leveraging Text::Glob, perform our own glob → regex conversion based on
Text::Glob::glob_to_regex_string and use that to perform matches.
Signed-off-by: James McCoy <jamessan at debian.org>
---
README | 4 +--
debian/control | 7 ++---
scripts/mk-origtargz.pl | 80 ++++++++++++++++++++++++++++++++-----------------
scripts/uscan.pl | 11 -------
test/test_mk-origtargz | 27 ++++++++++-------
5 files changed, 73 insertions(+), 56 deletions(-)
diff --git a/README b/README
index 0da6000..503cfc3 100644
--- a/README
+++ b/README
@@ -188,7 +188,7 @@ And now, in mostly alphabetical order, the scripts:
- mk-origtargz: Rename upstream tarball, optionally changing the compression
and removing unwanted files.
- [unzip, xz-utils, file, libtext-glob-perl]
+ [unzip, xz-utils, file]
- namecheck: Check project names are not already taken.
@@ -234,7 +234,7 @@ And now, in mostly alphabetical order, the scripts:
the updated version automatically, it is probably better not to without
testing it first. Uscan can also verify detached OpenPGP signatures if
upstream's signing key is known. [gpgv, gnupg, liblwp-protocol-https-perl,
- libwww-perl, libtext-glob-perl, unzip, xz-utils, file]
+ libwww-perl, unzip, xz-utils, file]
- uupdate: Update the package with an archive or patches from
an upstream author. This will be of help if you have to update your
diff --git a/debian/control b/debian/control
index 9f29f6a..52d82b4 100644
--- a/debian/control
+++ b/debian/control
@@ -16,7 +16,6 @@ Build-Depends: debhelper (>= 9),
libjson-perl,
libparse-debcontrol-perl,
libterm-size-perl,
- libtext-glob-perl,
libtimedate-perl,
liburi-perl,
libwww-perl,
@@ -56,7 +55,6 @@ Recommends: at,
libencode-locale-perl,
libjson-perl,
libparse-debcontrol-perl,
- libtext-glob-perl,
liburi-perl,
libwww-perl,
lintian,
@@ -173,7 +171,7 @@ Description: scripts to make the life of a Debian Package maintainer easier
package which may be installed to satisfy the build-dependencies of the
given package [equivs]
- mk-origtargz: rename upstream tarball, optionally changing the compression
- and removing unwanted files [unzip, xz-utils, file, libtext-glob-perl]
+ and removing unwanted files [unzip, xz-utils, file]
- namecheck: check project names are not already taken
- nmudiff: mail a diff of the current package against the previous version
to the BTS to assist in tracking NMUs [patchutils, mutt]
@@ -197,8 +195,7 @@ Description: scripts to make the life of a Debian Package maintainer easier
transitions for which uploads to unstable are currently blocked
[libwww-perl, libyaml-syck-perl]
- uscan: scan upstream sites for new releases of packages [gpgv, gnupg,
- liblwp-protocol-https-perl, libwww-perl, libtext-glob-perl, unzip,
- xz-utils, file]
+ liblwp-protocol-https-perl, libwww-perl, unzip, xz-utils, file]
- uupdate: integrate upstream changes into a source package [patch]
- what-patch: determine what patch system, if any, a source package is using
[patchutils]
diff --git a/scripts/mk-origtargz.pl b/scripts/mk-origtargz.pl
index 4fcff48..f994671 100755
--- a/scripts/mk-origtargz.pl
+++ b/scripts/mk-origtargz.pl
@@ -165,20 +165,6 @@ use Cwd 'abs_path';
use File::Copy;
use Dpkg::Control::Hash;
-use File::Basename;
-BEGIN {
- eval { require Text::Glob; };
- if ($@) {
- my $progname = basename($0);
- if ($@ =~ /^Can\'t locate Text\/Glob\.pm/) {
- die "$progname: you must have the libtext-glob-perl package installed\nto use this script\n";
- } else {
- die "$progname: problem loading the Text::Glob module:\n $@\nHave you installed the libtext-glob-perl package?\n";
- }
- }
-}
-
-
sub decompress_archive($$);
sub compress_archive($$$);
@@ -410,7 +396,7 @@ if ($repack) {
my $deletecount = 0;
my @to_delete;
-if (scalar @exclude_globs > 0) {
+if (@exclude_globs) {
my @files;
my $files;
spawn(exec => ['tar', '-t', '-a', '-f', $upstream_tar],
@@ -420,21 +406,14 @@ if (scalar @exclude_globs > 0) {
chomp @files;
# find out what to delete
- {
- no warnings 'once';
- $Text::Glob::strict_leading_dot = 0;
- $Text::Glob::strict_wildcard_slash = 0;
- }
+ my @exclude_regexes = map { glob_to_regex($_) } @exclude_globs;
+ my $regex = '^(?:[^/]*/)?' # Possible leading directory, ignore it
+ . '(?:' . join('|', @exclude_regexes) . ')' # User patterns
+ . '(?:/.*)?$'; # Possible trailing / for a directory
for my $filename (@files) {
- my $do_exclude = 0;
- for my $exclude (@exclude_globs) {
- $do_exclude ||=
- Text::Glob::match_glob("$exclude", $filename) ||
- Text::Glob::match_glob("$exclude/", $filename) ||
- Text::Glob::match_glob("*/$exclude", $filename) ||
- Text::Glob::match_glob("*/$exclude/", $filename);
+ if ($filename =~ m/$regex/) {
+ push @to_delete, $filename;
}
- push @to_delete, $filename if $do_exclude;
}
# ensure files are mentioned before the directory they live in
@@ -529,3 +508,48 @@ sub compress_archive($$$) {
wait_child => 1);
unlink $from_file;
}
+
+# Adapted from Text::Glob::glob_to_regex_string
+sub glob_to_regex {
+ my ($glob) = @_;
+
+ if ($glob =~ m@/$@) {
+ warn "WARNING: Files-Excluded pattern ($glob) should not have a trailing /\n";
+ chop($glob);
+ }
+ if ($glob =~ m/(?<!\\)(?:\\{2})*\\(?![\\*?])/) {
+ die "Invalid Files-Excluded pattern ($glob), \\ can only escape \\, *, or ? characters\n";
+ }
+
+ my ($regex, $escaping);
+ for my $c ($glob =~ m/(.)/gs) {
+ if ($c eq '.' || $c eq '(' || $c eq ')' || $c eq '|' ||
+ $c eq '+' || $c eq '^' || $c eq '$' || $c eq '@' || $c eq '%' ||
+ $c eq '{' || $c eq '}' || $c eq '[' || $c eq ']') {
+ $regex .= "\\$c";
+ }
+ elsif ($c eq '*') {
+ $regex .= $escaping ? "\\*" : ".*";
+ }
+ elsif ($c eq '?') {
+ $regex .= $escaping ? "\\?" : ".";
+ }
+ elsif ($c eq "\\") {
+ if ($escaping) {
+ $regex .= "\\\\";
+ $escaping = 0;
+ }
+ else {
+ $escaping = 1;
+ }
+ next;
+ }
+ else {
+ $regex .= $c;
+ $escaping = 0;
+ }
+ $escaping = 0;
+ }
+
+ return $regex;
+}
diff --git a/scripts/uscan.pl b/scripts/uscan.pl
index b34b1b8..90eec82 100755
--- a/scripts/uscan.pl
+++ b/scripts/uscan.pl
@@ -47,17 +47,6 @@ BEGIN {
}
}
}
-BEGIN {
- eval { require Text::Glob; };
- if ($@) {
- my $progname = basename($0);
- if ($@ =~ /^Can\'t locate Text\/Glob\.pm/) {
- die "$progname: you must have the libtext-glob-perl package installed\nto use this script\n";
- } else {
- die "$progname: problem loading the Text::Glob module:\n $@\nHave you installed the libtext-glob-perl package?\n";
- }
- }
-}
use Dpkg::Control::Hash;
my $CURRENT_WATCHFILE_VERSION = 3;
diff --git a/test/test_mk-origtargz b/test/test_mk-origtargz
index 11ae8c8..59b2403 100755
--- a/test/test_mk-origtargz
+++ b/test/test_mk-origtargz
@@ -63,6 +63,7 @@ makeUpstreamFiles () {
makeSubDir ".include-this-hidden-dir"
makeSubDir ".exclude-this-hidden-dir"
makeSubDir "a-dir/include-this-subdir"
+ # Expected not to be removed since exclusion is anchored to top-level
makeSubDir "a-dir/exclude-this-subdir"
touch "$TMPDIR/foo-0.1/; echo strange-file; #"
@@ -99,7 +100,7 @@ Files-Excluded: exclude-this*
.exclude-this*
exclude-dir1
exclude-dir2/
- ;\ echo\ strange-file;\ #
+ ;?echo?strange-file;?#
END
}
@@ -111,14 +112,20 @@ Files-Excluded: exclude-this*
.exclude-this*
exclude-dir1
exclude-dir2/
- ;\ echo\ strange-file;\ #
+ ;?echo?strange-file;?#
END
}
+expected_stderr_after_removal="WARNING: Files-Excluded pattern (exclude-dir2/) should not have a trailing /"
+
expected_files_after_removal=$(sort <<END
foo-0.1/
foo-0.1/a-dir/
+foo-0.1/a-dir/exclude-this-subdir/
+foo-0.1/a-dir/exclude-this-subdir/a-file
+foo-0.1/a-dir/exclude-this-subdir/a-subdir/
+foo-0.1/a-dir/exclude-this-subdir/a-subdir/a-file
foo-0.1/a-dir/include-this-subdir/
foo-0.1/a-dir/include-this-subdir/a-file
foo-0.1/a-dir/include-this-subdir/a-subdir/
@@ -306,8 +313,8 @@ testExclude() {
makeTarBall gz
makeDebanDir
makeDebianCopyright
- run_mk_origtargz foo "" \
- "Successfully repacked ../foo-0.1.tar.gz as ../foo_0.1.orig.tar.gz, deleting 17 files from it." \
+ run_mk_origtargz foo "$expected_stderr_after_removal" \
+ "Successfully repacked ../foo-0.1.tar.gz as ../foo_0.1.orig.tar.gz, deleting 19 files from it." \
../foo-0.1.tar.gz
assertTrue "result does not exist" "[ -e $TMPDIR/foo_0.1.orig.tar.gz ]"
assertType application/gzip $TMPDIR/foo_0.1.orig.tar.gz
@@ -318,8 +325,8 @@ testExcludeXZ() {
makeTarBall xz
makeDebanDir
makeDebianCopyright
- run_mk_origtargz foo "" \
- "Successfully repacked ../foo-0.1.tar.xz as ../foo_0.1.orig.tar.xz, deleting 17 files from it." \
+ run_mk_origtargz foo "$expected_stderr_after_removal" \
+ "Successfully repacked ../foo-0.1.tar.xz as ../foo_0.1.orig.tar.xz, deleting 19 files from it." \
../foo-0.1.tar.xz
assertTrue "result does not exist" "[ -e $TMPDIR/foo_0.1.orig.tar.xz ]"
assertType application/x-xz $TMPDIR/foo_0.1.orig.tar.xz
@@ -330,8 +337,8 @@ testExcludeZip() {
makeZipFile
makeDebanDir
makeDebianCopyright
- run_mk_origtargz foo "" \
- "Successfully repacked ../foo-0.1.zip as ../foo_0.1.orig.tar.xz, deleting 17 files from it." \
+ run_mk_origtargz foo "$expected_stderr_after_removal" \
+ "Successfully repacked ../foo-0.1.zip as ../foo_0.1.orig.tar.xz, deleting 19 files from it." \
../foo-0.1.zip --compression xz
assertTrue "result does not exist" "[ -e $TMPDIR/foo_0.1.orig.tar.xz ]"
assertType application/x-xz $TMPDIR/foo_0.1.orig.tar.xz
@@ -376,8 +383,8 @@ testSameNameExclude() {
mv $TMPDIR/foo-0.1.tar.gz $TMPDIR/foo_0.1.orig.tar.gz
makeDebanDir
makeDebianCopyright
- run_mk_origtargz foo "" \
- "Leaving ../foo_0.1.orig.tar.gz where it is, deleting 17 files from it." \
+ run_mk_origtargz foo "$expected_stderr_after_removal" \
+ "Leaving ../foo_0.1.orig.tar.gz where it is, deleting 19 files from it." \
../foo_0.1.orig.tar.gz
assertTrue "result does not exist" "[ -e $TMPDIR/foo_0.1.orig.tar.gz ]"
assertFalse "result is a symlink" "[ -L $TMPDIR/foo_0.1.orig.tar.gz ]"
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/collab-maint/devscripts.git
More information about the devscripts-devel
mailing list