return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
}
-sub upstreamversion ($) {
- my ($vsn) = @_;
- $vsn =~ s/-[^-]+$//;
- return $vsn;
-}
-
our $us = 'dgit';
initdebug('');
return cmdoutput @git, qw(hash-object -w -t commit), $file;
}
-sub make_commit_text ($) {
- my ($text) = @_;
- my ($out, $in);
- my @cmd = (@git, qw(hash-object -w -t commit --stdin));
- debugcmd "|",@cmd;
- print Dumper($text) if $debuglevel > 1;
- my $child = open2($out, $in, @cmd) or die $!;
- my $h;
- eval {
- print $in $text or die $!;
- close $in or die $!;
- $h = <$out>;
- $h =~ m/^\w+$/ or die;
- $h = $&;
- printdebug "=> $h\n";
- };
- close $out;
- waitpid $child, 0 == $child or die "$child $!";
- $? and failedcmd @cmd;
- return $h;
-}
-
sub clogp_authline ($) {
my ($clogp) = @_;
my $author = getfield $clogp, 'Maintainer';
sub multisuite_suite_child ($$$) {
- my ($tsuite, $merginputs, $fn) = @_;
+ my ($tsuite, $mergeinputs, $fn) = @_;
# in child, sets things up, calls $fn->(), and returns undef
# in parent, returns canonical suite name for $tsuite
my $canonsuitefh = IO::File::new_tmpfile;
return $csuite;
}
printdebug "multisuite $tsuite ok (canon=$csuite)\n";
- push @$merginputs, {
+ push @$mergeinputs, {
Ref => lrref,
Info => $csuite,
};
fetch_one();
finish 0;
});
- # xxx collecte the ref here
$csubsuite =~ s/^\Q$cbasesuite\E-/-/;
push @csuites, $csubsuite;
my $dgitview = git_rev_parse 'HEAD';
changedir $maindir;
- # When we no longer need to support squeeze, use --create-reflog
- # instead of this:
- ensuredir "$maindir_gitcommon/logs/refs/dgit-intern";
- my $makelogfh = new IO::File "$maindir_gitcommon/logs/refs/$splitbraincache", '>>'
- or die $!;
-
- my $oldcache = git_get_ref "refs/$splitbraincache";
- if ($oldcache eq $dgitview) {
- my $tree = cmdoutput qw(git rev-parse), "$dgitview:";
- # git update-ref doesn't always update, in this case. *sigh*
- my $dummy = make_commit_text <<END;
-tree $tree
-parent $dgitview
-author Dgit <dgit\@example.com> 1000000000 +0000
-committer Dgit <dgit\@example.com> 1000000000 +0000
-
-Dummy commit - do not use
-END
- runcmd @git, qw(update-ref -m), "dgit $our_version - dummy",
- "refs/$splitbraincache", $dummy;
- }
- runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
- $dgitview;
+ reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview;
changedir "$playground/work";
push @cachekey, $srcshash->hexdigest();
$splitbrain_cachekey = "@cachekey";
- my @cmd = (@git, qw(log -g), '--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 $maindir or die $!;
- if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
- $! == ENOENT or die $!;
- printdebug ">(no reflog)\n";
- finish 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;
+
+ my $cachehit = reflog_cache_lookup
+ "refs/$splitbraincache", $splitbrain_cachekey;
+
+ if ($cachehit) {
unpack_playtree_mkwork($headref);
my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
if ($cachehit ne $headref) {
progress "dgit view: found cached, no changes required";
return ($headref, $splitbrain_cachekey);
}
- die $! if GC->error;
- failedcmd unless close GC;
printdebug "splitbrain cache miss\n";
return (undef, $splitbrain_cachekey);