- my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
- print $fakedsc <<END or die $!;
-Format: 3.0 (quilt)
-Source: $package
-Version: $fakeversion
-Files:
-END
-
- my $dscaddfile=sub {
- my ($b) = @_;
-
- my $md = new Digest::MD5;
-
- my $fh = new IO::File $b, '<' or die "$b $!";
- stat $fh or die $!;
- my $size = -s _;
-
- $md->addfile($fh);
- print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
- };
-
- quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
-
- my @files=qw(debian/source/format debian/rules
- debian/control debian/changelog);
- foreach my $maybe (qw(debian/patches debian/source/options
- debian/tests/control)) {
- next unless stat_exists "../../../$maybe";
- push @files, $maybe;
- }
-
- my $debtar= srcfn $fakeversion,'.debian.tar.gz';
- runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files;
-
- $dscaddfile->($debtar);
- close $fakedsc or die $!;
-
- my $splitbrain_cachekey;
- if ($quilt_mode =~ m/gbp|dpm|unapplied/) {
- # we look in the reflog of dgit-intern/quilt-cache
- # we look for an entry whose message is the key for the cache lookup
- my @cachekey = (qw(dgit), $our_version);
- push @cachekey, $upstreamversion;
- push @cachekey, $headref;
-
- push @cachekey, hashfile('fake.dsc');
-
- my $srcshash = Digest::SHA->new(256);
- my %sfs = ( %INC, '$0(dgit)' => $0 );
- foreach my $sfk (sort keys %sfs) {
- $srcshash->add($sfk," ");
- $srcshash->add(hashfile($sfs{$sfk}));
- $srcshash->add("\n");
- }
- push @cachekey, $srcshash->hexdigest();
- $splitbrain_cachekey = "@cachekey";
-
- my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs',
- $splitbraincache);
- printdebug "splitbrain cachekey $splitbrain_cachekey\n";
- debugcmd "|(probably)",@cmd;
- my $child = open GC, "-|"; defined $child or die $!;
- if (!$child) {
- chdir '../../..' or die $!;
- if (!stat ".git/logs/refs/$splitbraincache") {
- $! == ENOENT or die $!;
- printdebug ">(no reflog)\n";
- exit 0;
- }
- exec @cmd; die $!;
- }
- while (<GC>) {
- chomp;
- printdebug ">| ", $_, "\n" if $debuglevel > 1;
- next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
-
- my $cachehit = $1;
- quilt_fixup_mkwork($headref);
- if ($cachehit ne $headref) {
- progress "quilt fixup ($quilt_mode mode) found cached tree";
- runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
- $split_brain = 1;
- return;
- }
- progress "quilt fixup ($quilt_mode mode)".
- " found cached indication that no changes needed";
- return;
- }
- die $! if GC->error;
- failedcmd unless close GC;
-
- printdebug "splitbrain cache miss\n";
- }