X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=3032c56d5f3f7a7178b41dd69e5a67e6a125905d;hp=e57f3ea9cfded0b0584554247d67553d7370e596;hb=f9de6d94951a129a0a90c688b15807da2d56e77a;hpb=6a15486772ae1aca46f196e6d2b46b30d82e4994

diff --git a/dgit b/dgit
index e57f3ea9..3032c56d 100755
--- a/dgit
+++ b/dgit
@@ -32,6 +32,7 @@ use Data::Dumper;
 use LWP::UserAgent;
 use Dpkg::Control::Hash;
 use File::Path;
+use File::Spec;
 use File::Temp qw(tempdir);
 use File::Basename;
 use Dpkg::Version;
@@ -257,7 +258,7 @@ sub forceing ($) {
 }
 
 sub no_such_package () {
-    print STDERR f_ "%s: package %s does not exist in suite %s\n",
+    print STDERR f_ "%s: source package %s does not exist in suite %s\n",
 	$us, $package, $isuite;
     finish 4;
 }
@@ -2207,60 +2208,60 @@ sub dotdot_bpd_transfer_origs ($$$) {
     my ($bpd_abs, $upstreamversion, $wanted) = @_;
     # checks is_orig_file_of_vsn and if
     # calls $wanted->{$leaf} and expects boolish
-    my $warned;
 
-    if ($buildproductsdir ne '..') {
-	my $dotdot = $maindir;
-	$dotdot =~ s{/[^/]+$}{};
-	opendir DD, $dotdot or fail "opendir .. ($dotdot): $!";
-	while ($!=0, defined(my $leaf = readdir DD)) {
-	    {
-		local ($debuglevel) = $debuglevel-1;
-		printdebug "DD_BPD $leaf ?\n";
-	    }
-	    next unless is_orig_file_of_vsn $leaf, $upstreamversion;
-	    next unless $wanted->($leaf);
-	    next if lstat "$bpd_abs/$leaf";
+    return if $buildproductsdir eq '..';
 
+    my $warned;
+    my $dotdot = $maindir;
+    $dotdot =~ s{/[^/]+$}{};
+    opendir DD, $dotdot or fail "opendir .. ($dotdot): $!";
+    while ($!=0, defined(my $leaf = readdir DD)) {
+	{
+	    local ($debuglevel) = $debuglevel-1;
+	    printdebug "DD_BPD $leaf ?\n";
+	}
+	next unless is_orig_file_of_vsn $leaf, $upstreamversion;
+	next unless $wanted->($leaf);
+	next if lstat "$bpd_abs/$leaf";
+
+	print STDERR f_
+ "%s: found orig(s) in .. missing from build-products-dir, transferring:\n",
+	    $us
+	    unless $warned++;
+	$! == &ENOENT or fail f_
+	    "check orig file %s in bpd %s: %s", $leaf, $bpd_abs, $!;
+	lstat "$dotdot/$leaf" or fail f_
+	    "check orig file %s in ..: %s", $leaf, $!;
+	if (-l _) {
+	    stat "$dotdot/$leaf" or fail f_
+		"check targe of orig symlink %s in ..: %s", $leaf, $!;
+	    my $ltarget = readlink "$dotdot/$leaf" or
+		die "readlink $dotdot/$leaf: $!";
+	    if ($ltarget !~ m{^/}) {
+		$ltarget = "$dotdot/$ltarget";
+	    }
+	    symlink $ltarget, "$bpd_abs/$leaf"
+		or die "$ltarget $bpd_abs $leaf: $!";
 	    print STDERR f_
-"%s: found orig(s) in .. missing from build-products-dir, transferring:\n",
-                $us
-		unless $warned++;
-	    $! == &ENOENT or fail f_
-		"check orig file %s in bpd %s: %s", $leaf, $bpd_abs, $!;
-	    lstat "$dotdot/$leaf" or fail f_
-		"check orig file %s in ..: %s", $leaf, $!;
-	    if (-l _) {
-		stat "$dotdot/$leaf" or fail f_
-		    "check targe of orig symlink %s in ..: %s", $leaf, $!;
-		my $ltarget = readlink "$dotdot/$leaf" or
-		    die "readlink $dotdot/$leaf: $!";
-		if ($ltarget !~ m{^/}) {
-		    $ltarget = "$dotdot/$ltarget";
-		}
-		symlink $ltarget, "$bpd_abs/$leaf"
-		    or die "$ltarget $bpd_abs $leaf: $!";
-		print STDERR f_
  "%s: cloned orig symlink from ..: %s\n",
-		    $us, $leaf;
-	    } elsif (link "$dotdot/$leaf", "$bpd_abs/$leaf") {
-		print STDERR f_
+		$us, $leaf;
+	} elsif (link "$dotdot/$leaf", "$bpd_abs/$leaf") {
+	    print STDERR f_
  "%s: hardlinked orig from ..: %s\n",
-		    $us, $leaf;
-	    } elsif ($! != EXDEV) {
-		fail f_ "failed to make %s a hardlink to %s: %s",
-		    "$bpd_abs/$leaf", "$dotdot/$leaf", $!;
-	    } else {
-		symlink "$bpd_abs/$leaf", "$dotdot/$leaf"
-		    or die "$bpd_abs $dotdot $leaf $!";
-		print STDERR f_
+		$us, $leaf;
+	} elsif ($! != EXDEV) {
+	    fail f_ "failed to make %s a hardlink to %s: %s",
+		"$bpd_abs/$leaf", "$dotdot/$leaf", $!;
+	} else {
+	    symlink "$bpd_abs/$leaf", "$dotdot/$leaf"
+		or die "$bpd_abs $dotdot $leaf $!";
+	    print STDERR f_
  "%s: symmlinked orig from .. on other filesystem: %s\n",
-		    $us, $leaf;
-	    }
+		$us, $leaf;
 	}
-	die "$dotdot; $!" if $!;
-	closedir DD;
     }
+    die "$dotdot; $!" if $!;
+    closedir DD;
 }
 
 sub generate_commits_from_dsc () {
@@ -2273,6 +2274,9 @@ sub generate_commits_from_dsc () {
     my $upstreamv = upstreamversion $dsc->{version};
     my @dfi = dsc_files_info();
 
+    dotdot_bpd_transfer_origs $bpd_abs, $upstreamv,
+	sub { grep { $_->{Filename} eq $_[0] } @dfi };
+
     foreach my $fi (@dfi) {
 	my $f = $fi->{Filename};
 	die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
@@ -7000,29 +7004,45 @@ END
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
 	my $f = $fi->{Filename};
+	# We transfer all the pieces of the dsc to the bpd, not just
+	# origs.  This is by analogy with dgit fetch, which wants to
+	# keep them somewhere to avoid downloading them again.
+	# We make symlinks, though.  If the user wants copies, then
+	# they can copy the parts of the dsc to the bpd using dcmd,
+	# or something.
 	my $here = "$buildproductsdir/$f";
 	if (lstat $here) {
-	    next if stat $here;
+	    if (stat $here) {
+		next;
+	    }
 	    fail f_ "lstat %s works but stat gives %s !", $here, $!;
 	}
 	fail f_ "stat %s: %s", $here, $! unless $! == ENOENT;
+	# $f does not exist in bpd, we need to transfer it
 	my $there = $dscfn;
-	if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
-	    $there = $';
-	} elsif ($dscfn =~ m#^/#) {
-	    $there = $dscfn;
+	$there =~ s{[^/]+$}{$f} or confess "$there ?";
+	# $there is file we want, relative to user's cwd, or abs
+	printdebug "not in bpd, $f, test $there ...\n";
+	stat $there or fail f_
+	    "import %s requires %s, but: %s", $dscfn, $there, $!;
+	if ($there =~ m#^(?:\./+)?\.\./+#) {
+	    # $there is relative to user's cwd
+	    my $there_from_parent = $';
+	    if ($buildproductsdir !~ m{^/}) {
+		# abs2rel, despite its name, can take two relative paths
+		$there = File::Spec->abs2rel($there,$buildproductsdir);
+		# now $there is relative to bpd, great
+	    } else {
+		$there = (dirname $maindir)."/$there_from_parent";
+		# now $there is absoute
+	    }
+	} elsif ($there =~ m#^/#) {
+	    # $there is absolute already
 	} else {
 	    fail f_
 		"cannot import %s which seems to be inside working tree!",
 		$dscfn;
 	}
-	$there =~ s#/+[^/]+$## or fail f_
-	    "import %s requires .../%s, but it does not exist",
-	    $dscfn, $f;
-	$there .= "/$f";
-	my $test = $there =~ m{^/} ? $there : "../$there";
-	stat $test or fail f_
-	    "import %s requires %s, but: %s", $dscfn, $test, $!;
 	symlink $there, $here or fail f_
 	    "symlink %s to %s: %s", $there, $here, $!;
 	progress f_ "made symlink %s -> %s", $here, $there;