[devscripts] 01/09: mk-origtargz: Adapt to typical coding style
James McCoy
jamessan at debian.org
Thu Apr 24 04:40:22 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 7eb443c2a7b5843f64da2d9772e7a7db89b5bd7e
Author: James McCoy <jamessan at debian.org>
Date: Mon Apr 21 10:19:05 2014 -0400
mk-origtargz: Adapt to typical coding style
Signed-off-by: James McCoy <jamessan at debian.org>
---
scripts/mk-origtargz.pl | 417 ++++++++++++++++++++++++------------------------
1 file changed, 208 insertions(+), 209 deletions(-)
diff --git a/scripts/mk-origtargz.pl b/scripts/mk-origtargz.pl
index bd7c9b7..45a5b15 100755
--- a/scripts/mk-origtargz.pl
+++ b/scripts/mk-origtargz.pl
@@ -167,12 +167,12 @@ use Dpkg::Control::Hash;
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";
- }
+ 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";
+ }
}
}
@@ -196,117 +196,117 @@ my $upstream = undef;
# option parsing
sub die_opts ($) {
- pod2usage({-exitval => 3, -verbose => 1, -msg => shift @_});
+ pod2usage({-exitval => 3, -verbose => 1, -msg => shift @_});
}
sub setmode {
- my $newmode = shift @_;
- if (defined $mode and $mode ne $newmode) {
- die_opts (sprintf "--%s and --%s are mutually exclusive", $mode, $newmode);
- }
- $mode = $newmode;
+ my $newmode = shift @_;
+ if (defined $mode and $mode ne $newmode) {
+ die_opts (sprintf "--%s and --%s are mutually exclusive", $mode, $newmode);
+ }
+ $mode = $newmode;
}
GetOptions(
- "package=s" => \$package,
- "version|v=s" => \$version,
- "exclude-file=s" => \@exclude_globs,
- "copyright-file=s" => \@copyright_files,
- "compression=s" => \$compression,
- "symlink" => \&setmode,
- "rename" => \&setmode,
- "copy" => \&setmode,
- "repack" => \$repack,
- "directory|C=s" => \$destdir,
- "help|h" => sub { pod2usage({-exitval => 0, -verbose => 1}); },
+ "package=s" => \$package,
+ "version|v=s" => \$version,
+ "exclude-file=s" => \@exclude_globs,
+ "copyright-file=s" => \@copyright_files,
+ "compression=s" => \$compression,
+ "symlink" => \&setmode,
+ "rename" => \&setmode,
+ "copy" => \&setmode,
+ "repack" => \$repack,
+ "directory|C=s" => \$destdir,
+ "help|h" => sub { pod2usage({-exitval => 0, -verbose => 1}); },
) or pod2usage({-exitval => 3, -verbose=>1});
$mode ||= "symlink";
# sanity checks
unless (compression_is_supported($compression)) {
- die_opts (sprintf "Unknown compression scheme %s", $compression);
+ die_opts (sprintf "Unknown compression scheme %s", $compression);
}
if (defined $package and not defined $version) {
- die_opts "If you use --package, you also have to specify --version."
+ die_opts "If you use --package, you also have to specify --version."
}
if (@ARGV != 1) {
- die_opts "Please specify original tarball."
+ die_opts "Please specify original tarball."
}
$upstream = $ARGV[0];
# get information from debian/
unless (defined $package) {
- # get package name
- open F, "debian/changelog" or die "debian/changelog: $!\n";
- my $line = <F>;
- close F;
- unless ($line =~ /^(\S+) \((\S+)\)/) {
- die "could not parse debian/changelog:1: $line";
- }
- $package = $1;
-
- # get version number
- unless (defined $version) {
- $version = $2;
- unless ($version =~ /-/) {
- print "Package with native version number $version; mk-origtargz makes no sense for native packages.\n";
- exit 0;
- }
- $version =~ s/(.*)-.*/$1/; # strip everything from the last dash
- $version =~ s/^\d+://; # strip epoch
+ # get package name
+ open F, "debian/changelog" or die "debian/changelog: $!\n";
+ my $line = <F>;
+ close F;
+ unless ($line =~ /^(\S+) \((\S+)\)/) {
+ die "could not parse debian/changelog:1: $line";
+ }
+ $package = $1;
+
+ # get version number
+ unless (defined $version) {
+ $version = $2;
+ unless ($version =~ /-/) {
+ print "Package with native version number $version; mk-origtargz makes no sense for native packages.\n";
+ exit 0;
}
+ $version =~ s/(.*)-.*/$1/; # strip everything from the last dash
+ $version =~ s/^\d+://; # strip epoch
+ }
- unshift @copyright_files, "debian/copyright"
- if -r "debian/copyright";
+ unshift @copyright_files, "debian/copyright" if -r "debian/copyright";
- # set destination directory
- unless (defined $destdir) {
- $destdir = "..";
- }
+ # set destination directory
+ unless (defined $destdir) {
+ $destdir = "..";
+ }
} else {
- unless (defined $destdir) {
- $destdir = ".";
- }
+ unless (defined $destdir) {
+ $destdir = ".";
+ }
}
for my $copyright_file (@copyright_files) {
- # get files-excluded
- my $data = Dpkg::Control::Hash->new();
- my $okformat = qr'http://www.debian.org/doc/packaging-manuals/copyright-format/[.\d]+';
- eval {
- $data->load($copyright_file);
- 1;
- } or do {
- undef $data;
- };
- if (not -e $copyright_file) {
- uscan_die ("File $copyright_file not found.");
- } elsif ( $data
- && defined $data->{'format'}
- && $data->{'format'} =~ m{^$okformat/?$})
- {
- if ($data->{'files-excluded'}) {
- my @rawexcluded = ($data->{"files-excluded"} =~ /(?:\A|\G\s+)((?:\\.|[^\\\s])+)/g);
- # un-escape
- push @exclude_globs, map { s/\\(.)/$1/g; s?/+$??; $_ } @rawexcluded;
- }
- } else {
- # be helpful
- my $has_files_excluded = 0;
- open COPYRIGHT, "debian/copyright" or die "debian/copyright $!\n";
- $has_files_excluded ||= /Files-Excluded/i while (<COPYRIGHT>);
- close COPYRIGHT;
- print STDERR
- "WARNING: The file debian/copyright mentions Files-Excluded, but its ".
- "format is not recognized. Specify Format: ".
- "http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ ".
- "in order to remove files from the tarball with mk_origtargz.\n"
- if ($has_files_excluded);
+ # get files-excluded
+ my $data = Dpkg::Control::Hash->new();
+ my $okformat = qr'http://www.debian.org/doc/packaging-manuals/copyright-format/[.\d]+';
+ eval {
+ $data->load($copyright_file);
+ 1;
+ } or do {
+ undef $data;
+ };
+ if (not -e $copyright_file) {
+ uscan_die ("File $copyright_file not found.");
+ } elsif ( $data
+ && defined $data->{'format'}
+ && $data->{'format'} =~ m{^$okformat/?$})
+ {
+ if ($data->{'files-excluded'})
+ {
+ my @rawexcluded = ($data->{"files-excluded"} =~ /(?:\A|\G\s+)((?:\\.|[^\\\s])+)/g);
+ # un-escape
+ push @exclude_globs, map { s/\\(.)/$1/g; s?/+$??; $_ } @rawexcluded;
}
+ } else {
+ # be helpful
+ my $has_files_excluded = 0;
+ open COPYRIGHT, "debian/copyright" or die "debian/copyright $!\n";
+ $has_files_excluded ||= /Files-Excluded/i while (<COPYRIGHT>);
+ close COPYRIGHT;
+ print STDERR
+ "WARNING: The file debian/copyright mentions Files-Excluded, but its ".
+ "format is not recognized. Specify Format: ".
+ "http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ ".
+ "in order to remove files from the tarball with mk_origtargz.\n"
+ if ($has_files_excluded);
+ }
}
@@ -315,31 +315,31 @@ for my $copyright_file (@copyright_files) {
my $zip_regex = qr/\.(zip|jar)$/;
# This makes more sense in Dpkg:Compression
my $tar_regex = qr/\.(tar\.gz |tgz
- |tar\.bz2 |tbz2?
- |tar.lzma |tlz(?:ma?)?
- |tar.xz |txz)$/x;
+ |tar\.bz2 |tbz2?
+ |tar.lzma |tlz(?:ma?)?
+ |tar.xz |txz)$/x;
my $is_zipfile = $upstream =~ $zip_regex;
my $is_tarfile = $upstream =~ $tar_regex;
unless (-e $upstream) {
- die "Could not read $upstream: $!"
+ die "Could not read $upstream: $!"
}
unless ($is_zipfile or $is_tarfile) {
- # TODO: Should we ignore the name and only look at what file knows?
- die "Parameter $upstream does not look like a tar archive or a zip file."
+ # TODO: Should we ignore the name and only look at what file knows?
+ die "Parameter $upstream does not look like a tar archive or a zip file."
}
if ($is_tarfile and not $repack) {
- # If we are not explicitly repacking, but need to generate a file
- # (usually due to Files-Excluded), then we want to use the original
- # compression scheme.
- $compression = compression_guess_from_file ($upstream);
+ # If we are not explicitly repacking, but need to generate a file
+ # (usually due to Files-Excluded), then we want to use the original
+ # compression scheme.
+ $compression = compression_guess_from_file ($upstream);
- if (not defined $compression) {
- die "Unknown or no compression used in $upstream."
- }
+ if (not defined $compression) {
+ die "Unknown or no compression used in $upstream."
+ }
}
@@ -358,45 +358,44 @@ my $zipfile_deleted = 0;
# If the file is a zipfile, we need to create a tarfile from it.
if ($is_zipfile) {
- system('command -v unzip >/dev/null 2>&1') >> 8 == 0
- or die("unzip binary not found. You need to install the package unzip to be able to repack .zip upstream archives.\n");
-
- my $tempdir = tempdir ("uscanXXXX", TMPDIR => 1, CLEANUP => 1);
- # Parent of the target directory should be under our control
- $tempdir .= '/repack';
- mkdir $tempdir or uscan_die("Unable to mkdir($tempdir): $!\n");
- system('unzip', '-q', '-a', '-d', $tempdir, $upstream_tar) == 0
- or uscan_die("Repacking from zip or jar failed (could not unzip)\n");
-
- # Figure out the top-level contents of the tarball.
- # If we'd pass "." to tar we'd get the same contents, but the filenames would
- # start with ./, which is confusing later.
- # This should also be more reliable than, say, changing directories and globbing.
- opendir(TMPDIR, $tempdir) || uscan_die("Can't open $tempdir $!\n");
- my @files = grep {$_ ne "." && $_ ne ".."} readdir(TMPDIR);
- close TMPDIR;
-
-
- # tar it all up
- spawn(exec => ['tar',
- '--owner=root', '--group=root', '--mode=a+rX',
- '--create', '--file', "$destfiletar",
- '--directory', $tempdir,
- @files],
- wait_child => 1);
- unless (-e "$destfiletar") {
- uscan_die("Repacking from zip or jar to tar.$suffix failed (could not create tarball)\n");
- }
- compress_archive($destfiletar, $destfile, $compression);
-
- # rename means the user did not want this file to exit afterwards
- if ($mode eq "rename") {
- unlink $upstream_tar;
- $zipfile_deleted++;
- }
+ system('command -v unzip >/dev/null 2>&1') >> 8 == 0
+ or die("unzip binary not found. You need to install the package unzip to be able to repack .zip upstream archives.\n");
+
+ my $tempdir = tempdir ("uscanXXXX", TMPDIR => 1, CLEANUP => 1);
+ # Parent of the target directory should be under our control
+ $tempdir .= '/repack';
+ mkdir $tempdir or uscan_die("Unable to mkdir($tempdir): $!\n");
+ system('unzip', '-q', '-a', '-d', $tempdir, $upstream_tar) == 0
+ or uscan_die("Repacking from zip or jar failed (could not unzip)\n");
+
+ # Figure out the top-level contents of the tarball.
+ # If we'd pass "." to tar we'd get the same contents, but the filenames would
+ # start with ./, which is confusing later.
+ # This should also be more reliable than, say, changing directories and globbing.
+ opendir(TMPDIR, $tempdir) || uscan_die("Can't open $tempdir $!\n");
+ my @files = grep {$_ ne "." && $_ ne ".."} readdir(TMPDIR);
+ close TMPDIR;
+
+ # tar it all up
+ spawn(exec => ['tar',
+ '--owner=root', '--group=root', '--mode=a+rX',
+ '--create', '--file', "$destfiletar",
+ '--directory', $tempdir,
+ @files],
+ wait_child => 1);
+ unless (-e "$destfiletar") {
+ uscan_die("Repacking from zip or jar to tar.$suffix failed (could not create tarball)\n");
+ }
+ compress_archive($destfiletar, $destfile, $compression);
+
+ # rename means the user did not want this file to exist afterwards
+ if ($mode eq "rename") {
+ unlink $upstream_tar;
+ $zipfile_deleted++;
+ }
- $mode = "repack";
- $upstream_tar = $destfile;
+ $mode = "repack";
+ $upstream_tar = $destfile;
}
# From now on, $upstream_tar is guaranteed to be a compressed tarball. It is always
@@ -405,11 +404,11 @@ if ($is_zipfile) {
# Find out if we have to repack
my $do_repack = 0;
if ($repack) {
- my $comp = compression_guess_from_file($upstream_tar);
- unless ($comp) {
- uscan_die("Cannot determine compression method of $upstream_tar");
- }
- $do_repack = $comp ne $compression;
+ my $comp = compression_guess_from_file($upstream_tar);
+ unless ($comp) {
+ uscan_die("Cannot determine compression method of $upstream_tar");
+ }
+ $do_repack = $comp ne $compression;
}
@@ -418,66 +417,66 @@ my $deletecount = 0;
my @to_delete;
if (scalar @exclude_globs > 0) {
- my @files;
- my $files;
- spawn(exec => ['tar', '-t', '-a', '-f', $upstream_tar],
- to_string => \$files,
- wait_child => 1);
- @files = split /^/, $files;
- chomp @files;
-
- # find out what to delete
- {
- no warnings 'once';
- $Text::Glob::strict_leading_dot = 0;
- $Text::Glob::strict_wildcard_slash = 0;
- }
- 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);
- }
- push @to_delete, $filename if $do_exclude;
+ my @files;
+ my $files;
+ spawn(exec => ['tar', '-t', '-a', '-f', $upstream_tar],
+ to_string => \$files,
+ wait_child => 1);
+ @files = split /^/, $files;
+ chomp @files;
+
+ # find out what to delete
+ {
+ no warnings 'once';
+ $Text::Glob::strict_leading_dot = 0;
+ $Text::Glob::strict_wildcard_slash = 0;
+ }
+ 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);
}
+ push @to_delete, $filename if $do_exclude;
+ }
- # ensure files are mentioned before the directory they live in
- # (otherwise tar complains)
- @to_delete = sort {$b cmp $a} @to_delete;
+ # ensure files are mentioned before the directory they live in
+ # (otherwise tar complains)
+ @to_delete = sort {$b cmp $a} @to_delete;
- $deletecount = scalar(@to_delete);
+ $deletecount = scalar(@to_delete);
}
# Actually do the unpack, remove, pack cycle
if ($do_repack || $deletecount) {
- decompress_archive($upstream_tar, $destfiletar);
- unlink $upstream_tar if $mode eq "rename";
- spawn(exec => ['tar', '--delete', '--file', $destfiletar, @to_delete ]
- ,wait_child => 1) if scalar(@to_delete) > 0;
- compress_archive($destfiletar, $destfile, $compression);
-
- # Symlink no longer makes sense
- $mode = "repack";
- $upstream_tar = $destfile;
+ decompress_archive($upstream_tar, $destfiletar);
+ unlink $upstream_tar if $mode eq "rename";
+ spawn(exec => ['tar', '--delete', '--file', $destfiletar, @to_delete ],
+ wait_child => 1) if scalar(@to_delete) > 0;
+ compress_archive($destfiletar, $destfile, $compression);
+
+ # Symlink no longer makes sense
+ $mode = "repack";
+ $upstream_tar = $destfile;
}
# Final step: symlink, copy or rename.
my $same_name = abs_path($destfile) eq abs_path($upstream);
unless ($same_name) {
- if ($mode ne "repack") { die "Assertion failed" unless $upstream_tar eq $upstream; }
-
- if ($mode eq "symlink") {
- my $rel = File::Spec->abs2rel( $upstream_tar, $destdir );
- symlink $rel, $destfile;
- } elsif ($mode eq "copy") {
- copy $upstream_tar, $destfile;
- } elsif ($mode eq "rename") {
- move $upstream_tar, $destfile;
- }
+ if ($mode ne "repack") { die "Assertion failed" unless $upstream_tar eq $upstream; }
+
+ if ($mode eq "symlink") {
+ my $rel = File::Spec->abs2rel( $upstream_tar, $destdir );
+ symlink $rel, $destfile;
+ } elsif ($mode eq "copy") {
+ copy $upstream_tar, $destfile;
+ } elsif ($mode eq "rename") {
+ move $upstream_tar, $destfile;
+ }
}
# Tell the use what we did
@@ -486,26 +485,26 @@ my $upstream_nice = File::Spec->canonpath($upstream);
my $destfile_nice = File::Spec->canonpath($destfile);
if ($same_name) {
- print "Leaving $destfile_nice where it is";
+ print "Leaving $destfile_nice where it is";
} else {
- if ($is_zipfile or $do_repack or $deletecount) {
- print "Successfully repacked $upstream_nice as $destfile_nice";
- } elsif ($mode eq "symlink") {
- print "Successfully symlinked $upstream_nice to $destfile_nice";
- } elsif ($mode eq "copy") {
- print "Successfully copied $upstream_nice to $destfile_nice";
- } elsif ($mode eq "rename") {
- print "Successfully renamed $upstream_nice to $destfile_nice";
- } else {
- die "Unknown mode $mode."
- }
+ if ($is_zipfile or $do_repack or $deletecount) {
+ print "Successfully repacked $upstream_nice as $destfile_nice";
+ } elsif ($mode eq "symlink") {
+ print "Successfully symlinked $upstream_nice to $destfile_nice";
+ } elsif ($mode eq "copy") {
+ print "Successfully copied $upstream_nice to $destfile_nice";
+ } elsif ($mode eq "rename") {
+ print "Successfully renamed $upstream_nice to $destfile_nice";
+ } else {
+ die "Unknown mode $mode."
+ }
}
if ($deletecount) {
- print ", deleting ${deletecount} files from it";
+ print ", deleting ${deletecount} files from it";
}
if ($zipfile_deleted) {
- print ", and removed the original file"
+ print ", and removed the original file"
}
print ".\n";
@@ -515,14 +514,14 @@ sub decompress_archive($$) {
my ($from_file, $to_file) = @_;
my $comp = compression_guess_from_file($from_file);
unless ($comp) {
- uscan_die("Cannot determine compression method of $from_file");
+ uscan_die("Cannot determine compression method of $from_file");
}
my $cmd = compression_get_property($comp, 'decomp_prog');
spawn(exec => $cmd,
- from_file => $from_file,
- to_file => $to_file,
- wait_child => 1);
+ from_file => $from_file,
+ to_file => $to_file,
+ wait_child => 1);
}
sub compress_archive($$$) {
@@ -531,8 +530,8 @@ sub compress_archive($$$) {
my $cmd = compression_get_property($comp, 'comp_prog');
push(@{$cmd}, '-'.compression_get_property($comp, 'default_level'));
spawn(exec => $cmd,
- from_file => $from_file,
- to_file => $to_file,
- wait_child => 1);
+ from_file => $from_file,
+ to_file => $to_file,
+ wait_child => 1);
unlink $from_file;
}
--
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