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 <[email protected]> Date: Mon Apr 21 10:19:05 2014 -0400 mk-origtargz: Adapt to typical coding style Signed-off-by: James McCoy <[email protected]> --- 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 _______________________________________________ devscripts-devel mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/devscripts-devel
