my $oid_b = $want->{oid_b};
my ($oid_full, $type, $size) = $git->check($oid_b);
- # other than {oid_b, try_gits, try_ibxs}
- my $have_hints = scalar keys %$want > 3;
- if (defined($type) && (!$have_hints || $type eq 'blob')) {
+ if ($oid_b eq ($oid_full // '') || (defined($type) &&
+- (!$self->{have_hints} || $type eq 'blob'))) {
delete $want->{try_gits};
return [ $git, $oid_full, $type, int($size) ]; # done, success
}
scalar(@$try);
}
+sub _tmp {
+ $_[0]->{tmp} //=
+ File::Temp->newdir("solver.$_[0]->{oid_want}-XXXX", TMPDIR => 1);
+}
+
sub extract_diff ($$) {
my ($p, $arg) = @_;
my ($self, $want, $smsg) = @$arg;
my $path = ++$self->{tot};
$di->{n} = $path;
- open(my $tmp, '>:utf8', $self->{tmp}->dirname . "/$path") or
- die "open(tmp): $!";
+ my $f = _tmp($self)->dirname."/$path";
+ open(my $tmp, '>:utf8', $f) or die "open($f): $!";
print $tmp $di->{hdr_lines}, $patch or die "print(tmp): $!";
close $tmp or die "close(tmp): $!";
# pure Perl "git init"
sub do_git_init ($) {
my ($self) = @_;
- my $dir = $self->{tmp}->dirname;
- my $git_dir = "$dir/git";
+ my $git_dir = _tmp($self)->dirname.'/git';
foreach ('', qw(objects refs objects/info refs/heads)) {
mkdir("$git_dir/$_") or die "mkdir $_: $!";
sub parse_ls_files ($$) {
my ($self, $bref) = @_;
my ($qsp_err, $di) = delete @$self{qw(-qsp_err -cur_di)};
- die "git ls-files error:$qsp_err" if $qsp_err;
+ die "git ls-files -s -z error:$qsp_err" if $qsp_err;
- my ($line, @extra) = split(/\0/, $$bref);
+ my @ls = split(/\0/, $$bref);
+ my ($line, @extra) = grep(/\t\Q$di->{path_b}\E\z/, @ls);
scalar(@extra) and die "BUG: extra files in index: <",
- join('> <', @extra), ">";
-
+ join('> <', $line, @extra), ">";
+ $line // die "no \Q$di->{path_b}\E in <",join('> <', @ls), '>';
my ($info, $file) = split(/\t/, $line, 2);
my ($mode_b, $oid_b_full, $stage) = split(/ /, $info);
- if ($file ne $di->{path_b}) {
- die
+ $file eq $di->{path_b} or die
"BUG: index mismatch: file=$file != path_b=$di->{path_b}";
- }
my $tmp_git = $self->{tmp_git} or die 'no git working tree';
my (undef, undef, $size) = $tmp_git->check($oid_b_full);
dbg($self, 'trying '.di_url($self, $nxt));
return do_git_apply($self);
} else {
+ $msg .= " (no patches left to try for $di->{oid_b})\n";
ERR($self, $msg);
}
} else {
sub do_git_apply ($) {
my ($self) = @_;
- my $dn = $self->{tmp}->dirname;
my $patches = $self->{patches};
# we need --ignore-whitespace because some patches are CRLF
my @cmd = (qw(git apply --cached --ignore-whitespace
--unidiff-zero --whitespace=warn --verbose));
my $len = length(join(' ', @cmd));
- my $total = $self->{tot};
my $di; # keep track of the last one for "git ls-files"
my $prv_oid_b;
do {
my $i = ++$self->{nr};
$di = shift @$patches;
- dbg($self, "\napplying [$i/$total] " . di_url($self, $di) .
- "\n" . $di->{hdr_lines});
+ dbg($self, "\napplying [$i/$self->{nr_p}] " .
+ di_url($self, $di) . "\n" . $di->{hdr_lines});
my $path = $di->{n};
$len += length($path) + 1;
push @cmd, $path;
} while (@$patches && $len < $ARG_SIZE_MAX &&
!oids_same_ish($patches->[0]->{oid_b}, $prv_oid_b));
- my $opt = { 2 => 1, -C => $dn, quiet => 1 };
+ my $opt = { 2 => 1, -C => _tmp($self)->dirname, quiet => 1 };
my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}, $opt);
$self->{-cur_di} = $di;
$qsp->{qsp_err} = \($self->{-qsp_err} = '');
my $diffs = delete $self->{tmp_diffs};
if (scalar @$diffs) {
unshift @{$self->{patches}}, @$diffs;
- dbg($self, "found $want->{oid_b} in " . join(" ||\n\t",
- map { di_url($self, $_) } @$diffs));
+ my %seen; # List::Util::uniq requires Perl 5.26+ :<
+ my @u = grep { !$seen{$_}++ } map { di_url($self, $_) } @$diffs;
+ dbg($self, "found $want->{oid_b} in " . join(" ||\n\t", @u));
+ ++$self->{nr_p};
# good, we can find a path to the oid we $want, now
# lets see if we need to apply more patches:
# scan through inboxes to look for emails which results in
# the oid we want:
- my $ibx = shift(@{$want->{try_ibxs}}) or die 'BUG: {try_ibxs} empty';
+ my $ibx = shift(@{$want->{try_ibxs}}) or return done($self, undef);
if (my $msgs = find_smsgs($self, $ibx, $want)) {
$want->{try_smsgs} = $msgs;
$want->{cur_ibx} = $ibx;
sub new {
my ($class, $ibx, $user_cb, $uarg) = @_;
- bless {
- gits => $ibx->{-repo_objs},
+ bless { # $ibx is undef if coderepo only (see WwwCoderepo)
+ gits => $ibx ? $ibx->{-repo_objs} : undef,
user_cb => $user_cb,
uarg => $uarg,
# -cur_di, -qsp_err, -msg => temp fields for Qspawn callbacks
# TODO: config option for searching related inboxes
- inboxes => [ $ibx ],
+ inboxes => $ibx ? [ $ibx ] : [],
}, $class;
}
$self->{oid_want} = $oid_want;
$self->{out} = $out;
$self->{seen_oid} = {};
- $self->{tot} = 0;
+ $self->{tot} = $self->{nr_p} = 0;
$self->{psgi_env} = $env;
+ $self->{have_hints} = 1 if scalar keys %$hints;
$self->{todo} = [ { %$hints, oid_b => $oid_want } ];
$self->{patches} = []; # [ $di, $di, ... ]
$self->{found} = {}; # { abbr => [ ::Git, oid, type, size, $di ] }
- $self->{tmp} = File::Temp->newdir("solver.$oid_want-XXXX", TMPDIR => 1);
dbg($self, "solving $oid_want ...");
if (my $async = $env->{'pi-httpd.async'}) {