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 <[email protected]> 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 <[email protected]> --- 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 _______________________________________________ devscripts-devel mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/devscripts-devel
