add check for uncommitted files in git repo

This can be overridden by using -W.

scripts/Dpkg/Source/VCS/git.pm

@@ -11,19 +11,42 @@ use Dpkg::Gettext;
 push (@INC, $dpkglibdir);
 require 'controllib.pl';
 
-sub populate_tarball {
+# Called before a tarball is created, must add all files that should be in
+# it.
+sub prep_tar {
 	my $srcdir=shift;
 	my $tardir=shift;
 
-	# TODO check for uncommitted files
-	# TODO run git-gc --prune first
+	# check for uncommitted files
+	open(GIT_STATUS, "LANG=C cd $srcdir && git status |") ||
+		subprocerr("cd $srcdir && git status");
+	my $clean=0;
+	my $status="";
+	while (<GIT_STATUS>) {
+		if (/^\Qnothing to commit (working directory clean)\E$/) {
+			$clean=1;
+		}
+		$status.=$_;
+	}
+	close GIT_STATUS;
+	# git-status exits 1 if there are uncommitted changes or if
+	# the repo is clean, and 0 if there are uncommitted changes
+	# listed in the index.
+	if ($? && $? >> 8 != 1) {
+		print $status;
+		warnerror("working directory is not clean (use -W to override this check)");
+	}
+	# garbage collect the repo
+	system("cd $srcdir && git-gc --prune");
+	$? && subprocerr("cd $srcdir && git-gc --prune");
 	# TODO support for creating a shallow clone for those cases where
 	# uploading the whole repo history is not desired
 	system("cp -a $srcdir/.git $tardir");
 	$? && subprocerr("cp -a $srcdir/.git $tardir");
 }
 
-sub initialize_repo {
+# Called after a tarball is unpacked, to check out the working copy.
+sub post_unpack_tar {
 	my $srcdir=shift;
 	
 	# TODO disable git hooks

scripts/dpkg-source.pl

@@ -482,7 +482,7 @@ if ($opmode eq 'build') {
             &syserr(sprintf(_g("unable to create `%s'"), $tardirname));
 	push @exit_handlers, sub { erasedir($tardirname) };
         
-	eval qq{Dpkg::Source::VCS::${vcs}::populate_tarball($dir, \$tardirname)};
+	eval qq{Dpkg::Source::VCS::${vcs}::prep_tar($dir, \$tardirname)};
 	if ($@) {
             &syserr($@);
 	}
@@ -975,7 +975,7 @@ if ($opmode eq 'build') {
 	    printf(_g("%s: extracting source from %s repository")."\n", $progname, $vcsfiles{$tarfile});
 	    loadvcs($vcsfiles{$tarfile})
 	    	|| error(sprintf(_g("unsupported vcs \"%s\""), $vcsfiles{$tarfile}));
-	    eval qq{Dpkg::Source::VCS::$vcsfiles{$tarfile}::initialize_repo(\$target)};
+	    eval qq{Dpkg::Source::VCS::$vcsfiles{$tarfile}::post_unpack_tar(\$target)};
 	    if ($@) {
                 &syserr($@);
 	    }