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 84e18e8bee99878b85d42e1c42a5073b3fe67e48..686782895e1762d1b7a14c9c231760221d845f8f 100644 (file)
--- 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 (<GIT_CONFIG>) {
                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 (<GIT_LS_FILES>) {
                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 7ad4ccb8f32415ece229108d31b3828bd7b04f70..5e4fc95712d2d8d3719470f8f5bb552a23af5f8d 100755 (executable)
--- 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) };
     }