From: Frank Lichtenheld Date: Sun, 10 Feb 2008 20:26:31 +0000 (+0100) Subject: Fix sourcev3 code to work with current dpkg-dev X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=885ec2ac16c8369bcdaff7854d0ba2edb04b2893;p=dpkg Fix sourcev3 code to work with current dpkg-dev Use Dpkg::ErrorHandling and fix some other errors --- diff --git a/scripts/Dpkg/Source/VCS/git.pm b/scripts/Dpkg/Source/VCS/git.pm index 84e18e8b..68678289 100644 --- a/scripts/Dpkg/Source/VCS/git.pm +++ b/scripts/Dpkg/Source/VCS/git.pm @@ -25,9 +25,7 @@ use Cwd; use File::Find; use Dpkg; use Dpkg::Gettext; - -push (@INC, $dpkglibdir); -require 'controllib.pl'; +use Dpkg::ErrorHandling qw(error warning subprocerr syserr); # Remove variables from the environment that might cause git to do # something unexpected. @@ -43,29 +41,32 @@ sub import { return 1; } } - main::error(sprintf(_g("This source package can only be manipulated using git, which is not in the PATH."))); + error(_g("This source package can only be manipulated using git, which is not in the PATH.")); } sub sanity_check { my $srcdir=shift; if (! -d "$srcdir/.git") { - main::error(sprintf(_g("source directory is not the top directory of a git repository (%s/.git not present), but Format git was specified"), $srcdir)); + error(_g("source directory is not the top directory of a git repository (%s/.git not present), but Format git was specified"), + $srcdir); } if (-s "$srcdir/.gitmodules") { - main::error(sprintf(_g("git repository %s uses submodules. This is not yet supported."), $srcdir)); + error(_g("git repository %s uses submodules. This is not yet supported."), + $srcdir); } # Symlinks from .git to outside could cause unpack failures, or # point to files they shouldn't, so check for and don't allow. if (-l "$srcdir/.git") { - main::error(sprintf(_g("%s is a symlink"), "$srcdir/.git")); + error(_g("%s is a symlink"), "$srcdir/.git"); } my $abs_srcdir=Cwd::abs_path($srcdir); find(sub { if (-l $_) { if (Cwd::abs_path(readlink($_)) !~ /^\Q$abs_srcdir\E(\/|$)/) { - main::error(sprintf(_g("%s is a symlink to outside %s"), $File::Find::name, $srcdir)); + error(_g("%s is a symlink to outside %s"), + $File::Find::name, $srcdir); } } }, "$srcdir/.git"); @@ -79,7 +80,7 @@ sub read_git_config { my %ret; open(GIT_CONFIG, '-|', "git", "config", "--file", $file, "--null", "-l") || - main::subprocerr("git config"); + subprocerr("git config"); my ($key, $value); while () { if (! defined $key) { @@ -101,7 +102,7 @@ sub read_git_config { if (defined $key && length $key) { push @{$ret{$key}}, $value; } - close(GIT_CONFIG) || main::syserr("git config exited nonzero"); + close(GIT_CONFIG) || syserr(_g("git config exited nonzero")); return \%ret; } @@ -115,7 +116,7 @@ sub prep_tar { my $old_cwd=getcwd(); chdir($srcdir) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $srcdir)); + syserr(_g("unable to chdir to `%s'"), $srcdir); # Check for uncommitted files. # To support dpkg-source -i, get a list of files @@ -130,9 +131,9 @@ sub prep_tar { if (-e ".git/info/exclude") { push @ignores, "--exclude-from=.git/info/exclude"; } - open(GIT_LS_FILES, '-|', "git ls-files", "--modified", "--deleted", - "--others", @ignores) || - main::subprocerr("git ls-files"); + open(GIT_LS_FILES, '-|', "git", "ls-files", "--modified", "--deleted", + "--others", @ignores) || + subprocerr("git ls-files"); my @files; while () { chomp; @@ -141,22 +142,22 @@ sub prep_tar { push @files, $_; } } - close(GIT_LS_FILES) || main::syserr("git ls-files exited nonzero"); + close(GIT_LS_FILES) || syserr(_g("git ls-files exited nonzero")); if (@files) { - main::error(sprintf(_g("uncommitted, not-ignored changes in working directory: %s"), - join(" ", @files))); + error(_g("uncommitted, not-ignored changes in working directory: %s"), + join(" ", @files)); } # git clone isn't used to copy the repo because the it might be an # unclonable shallow copy. chdir($old_cwd) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + syserr(_g("unable to chdir to `%s'"), $old_cwd); mkdir($tardir,0755) || - main::syserr(sprintf(_g("unable to create `%s'"), $tardir)); + syserr(_g("unable to create `%s'"), $tardir); system("cp", "-a", "$srcdir/.git", $tardir); - $? && main::subprocerr("cp -a $srcdir/.git $tardir"); + $? && subprocerr("cp -a $srcdir/.git $tardir"); chdir($tardir) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $tardir)); + syserr(_g("unable to chdir to `%s'"), $tardir); # TODO support for creating a shallow clone for those cases where # uploading the whole repo history is not desired @@ -165,14 +166,14 @@ sub prep_tar { # First, delete the whole reflog, which is not needed in a # distributed source package. system("rm", "-rf", ".git/logs"); - $? && main::subprocerr("rm -rf .git/logs"); + $? && subprocerr("rm -rf .git/logs"); system("git", "gc", "--prune"); - $? && main::subprocerr("git gc --prune"); + $? && subprocerr("git gc --prune"); # .git/gitweb is created and used by git instaweb and should not be # transferwed by source package. system("rm", "-rf", ".git/gitweb"); - $? && main::subprocerr("rm -rf .git/gitweb"); + $? && subprocerr("rm -rf .git/gitweb"); # As an optimisation, remove the index. It will be recreated by git # reset during unpack. It's probably small, but you never know, this @@ -181,7 +182,7 @@ sub prep_tar { unlink(".git/index"); # error intentionally ignored chdir($old_cwd) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + syserr(_g("unable to chdir to `%s'"), $old_cwd); return 1; } @@ -194,15 +195,15 @@ sub post_unpack_tar { my $old_cwd=getcwd(); chdir($srcdir) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $srcdir)); + syserr(_g("unable to chdir to `%s'"), $srcdir); # Disable git hooks, as unpacking a source package should not # involve running code. foreach my $hook (glob("./.git/hooks/*")) { if (-x $hook) { - main::warning(sprintf(_g("executable bit set on %s; clearing"), $hook)); + warning(_g("executable bit set on %s; clearing"), $hook); chmod(0666 &~ umask(), $hook) || - main::syserr(sprintf(_g("unable to change permission of `%s'"), $hook)); + syserr(_g("unable to change permission of `%s'"), $hook); } } @@ -211,7 +212,7 @@ sub post_unpack_tar { # present (git will recreate it as needed). if (-e ".git/index" || -l ".git/index") { unlink(".git/index") || - main::syserr(sprintf(_g("unable to remove `%s'"), ".git/index")); + syserr(_g("unable to remove `%s'"), ".git/index"); } # Comment out potentially probamatic or annoying stuff in @@ -233,13 +234,13 @@ sub post_unpack_tar { else { system("git", "config", "--file", ".git/config", "--unset-all", $field); - $? && main::subprocerr("git config --file .git/config --unset-all $field"); + $? && subprocerr("git config --file .git/config --unset-all $field"); } } if (%config) { - main::warning(_g("modifying .git/config to comment out some settings")); + warning(_g("modifying .git/config to comment out some settings")); open(GIT_CONFIG, ">>", ".git/config") || - main::syserr(sprintf(_g("unstable to append to %s", ".git/config"))); + syserr(_g("unstable to append to %s"), ".git/config"); print GIT_CONFIG "\n# "._g("The following setting(s) were disabled by dpkg-source").":\n"; foreach my $field (sort keys %config) { foreach my $value (@{$config{$field}}) { @@ -252,15 +253,15 @@ sub post_unpack_tar { # .git/gitweb is created and used by git instaweb and should not be # transferwed by source package. system("rm", "-rf", ".git/gitweb"); - $? && main::subprocerr("rm -rf .git/gitweb"); + $? && subprocerr("rm -rf .git/gitweb"); # git checkout is used to repopulate the WC with files # and recreate the index. system("git", "checkout", "-f"); - $? && main::subprocerr("git checkout -f"); + $? && subprocerr("git checkout -f"); chdir($old_cwd) || - main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + syserr(_g("unable to chdir to `%s'"), $old_cwd); return 1; } diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 7ad4ccb8..5e4fc957 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -399,31 +399,36 @@ if ($opmode eq 'build') { } my $vcs; - if ($f{Format} =~ /^\s*(\d+\.\d+)\s*$/) { + if ($fields->{Format} =~ /^\s*(\d+\.\d+)\s*$/) { if ($1 >= 3.0) { - error(sprintf(_g("don't know how to generate %s format source package (missing vcs specifier in Format field?)"), $1)); + error(_g("don't know how to generate %s format source package (missing vcs specifier in Format field?)"), + $1); } if ($1 > 1.0) { - error(sprintf(_g("don't know how to generate %s format source package"), $1)); + error(_g("don't know how to generate %s format source package"), + $1); } } - elsif ($f{Format} =~ /^\s*(\d+(?:\.\d+)?)\s+\((\w+)\)\s*$/) { - $f{Format}=$1; + elsif ($fields->{Format} =~ /^\s*(\d+(?:\.\d+)?)\s+\((\w+)\)\s*$/) { + $fields->{Format} = $1; if ($1 < 3.0) { - error(sprintf(_g("control info file 'Format' field for version %s does not support vcs specifier \"%s\""), $1, $2)); + error(_g("control info file 'Format' field for version %s does not support vcs specifier \"%s\""), + $1, $2); + } + if ($1 >= 4) { + error(_g("unsupported control info file 'Format' value \"%s\""), + $1); } - if ($1 >= 4) { - error(sprintf(_g("unsupported control info file 'Format' value \"%s\""), $1)); - } - $vcs=$2; + $vcs = $2; loadvcs($2) - || error(sprintf(_g("unsupported vcs \"%s\" in control info file 'Format' field"), $2)); - + || error(_g("unsupported vcs \"%s\" in control info file 'Format' field"), $2); + if ($sourcestyle =~ /[akpursKPUR]/) { - warning(sprintf(_g("source handling style -s%s not supported when generating %s format source package"), $sourcestyle, $vcs)); - } - $sourcestyle='v'; + warning(_g("source handling style -s%s not supported when generating %s format source package"), + $sourcestyle, $vcs); + } + $sourcestyle = 'v'; } $sourcestyle =~ y/X/A/; @@ -544,7 +549,7 @@ if ($opmode eq 'build') { eval qq{Dpkg::Source::VCS::${vcs}::prep_tar(\$dir, \$tardirname)}; if ($@) { - &syserr($@); + failure($@); } push @exit_handlers, sub { erasedir($tardirname) }; }