App-Greple

 view release on metacpan or  search on metacpan

RIPGREP-STUDY.md  view on Meta::CPAN

実測でも大規模ツリー検索で 5 倍以上（ツリーが大きくマッチが疎なほど拡大）の改善を確認した。

## 2. 現状分析: greple のアーキテクチャ

サブエージェントによるコード調査結果の要点（file:line は現 master 基準）。

### 2.1 処理モデル

- **slurp 方式**: ファイル全体を 1 スカラ文字列として読む（`script/greple:989-1023`）。
  行単位ストリーミングではない。
- **文字単位オフセット**: 入力は `binmode STDIN, ":encoding($file_code)"`（`script/greple:1226`）で
  読み込み時にデコードされ、以後の検索・領域演算はすべて **Perl 内部文字列上の文字オフセット**で行われる。
  `Regions.pm` の `match_regions`（`lib/App/Greple/Regions.pm:97-117`）は
  `pos() - length(${^MATCH})` で `[from, to]` を算出する。
- **領域代数**: `--inside/--outside/--include/--exclude`、ブロック構築、must/need/allow 判定は
  すべて `[from, to]` ペア配列に対する集合演算（`Regions.pm`, `Grep.pm`）。
- **Perl 正規表現への依存**: `/p` + `${^MATCH}`、`pos()`、`\G` + `\X`（`Pattern.pm:134`）、
  可変長後読み、ユーザーパターンの Perl 方言全般。
- **モジュール結合点**: `--inside '&func'` 等の関数パターンは `$_` にファイル内容が入った状態で
  呼ばれ、`[from, to]` の領域リストを返す（`Grep.pm:444-457`）。`--begin/--end/--postgrep/--print`
  も同様に Perl コードが検索パイプラインへ直接介入する。

RIPGREP-STUDY.md  view on Meta::CPAN

### 2.3 ボトルネックの分解

上の数値から greple の 1 実行あたりのコスト内訳を分解できる。

| フェーズ | 実測値 | 備考 |
|---|---|---|
| 起動（モジュールロード・オプション処理） | 44ms | Getopt::EX 等。どの方式でも残る下限 |
| デコード + 正規表現スキャン | 約 80ms / 26MB | マッチ 0 件時 0.124s − 起動 44ms |
| **マッチ後処理**（Match/Block 構築・領域演算・カウント） | **約 7µs / マッチ** | 10 万マッチで 0.7〜0.9s。**支配的コスト** |
| ファイルごとのオーバーヘッド | 約 0.25ms / ファイル | open・binmode・slurp 等 |

**含意**: rg が 26MB を 10ms で走査するのに対し greple のスキャンフェーズは 80ms — 差は 8 倍だが
絶対値は小さい。マッチが多い場合の 0.8〜1.0s の大半はスキャンではなく
**マッチ後の Perl 側処理**であり、これは初期マッチ列挙を外部化しても消えない。
つまり「rg に位置を出させる」方式の理論上の改善上限は、このワークロードでは 1 割程度しかない。

## 3. ripgrep 側の事実確認

### 3.1 `--json` 出力（実測確認済み）

lib/App/Greple/Grep.pm  view on Meta::CPAN

	for my $i (@chunk) {
	    my $pat = $patlist->[$i];
	    pipe(my $r, my $w) or last;
	    my $pid = fork;
	    if (not defined $pid) {	# fall back to sequential
		close $r; close $w;
		last;
	    }
	    if ($pid == 0) {
		close $r;
		binmode $w;
		my @p = match_regions(pattern => $pat->regex,
				      group => $self->{group_index},
				      index => $self->{group_index} >= 2);
		my $data = pack 'J*',
		    map { ($_->[0], $_->[1], $_->[2] // NO_INDEX) } @p;
		syswrite $w, $data if length $data;
		close $w;
		POSIX::_exit(0);
	    }
	    close $w;
	    binmode $r;
	    push @child, [ $i, $pid, $r ];
	}
	for (@child) {
	    my($i, $pid, $r) = @$_;
	    my $data = do { local $/; <$r> };
	    close $r;
	    waitpid $pid, 0;
	    next if $? != 0;		# fall back to sequential
	    my @v = unpack 'J*', $data // '';
	    my @p;

lib/App/Greple/Grep.pm  view on Meta::CPAN

    my $threshold = $ENV{GREPLE_PARALLEL_THRESHOLD} // $default_threshold;
    return if length() < $threshold;
    pipe(my $r, my $w) or return;
    my $pid = fork;
    if (not defined $pid) {		# fall back to sequential
	close $r; close $w;
	return;
    }
    if ($pid == 0) {
	close $r;
	binmode $w;
	my $data = pack 'J*', match_borders $self->{border};
	syswrite $w, $data if length $data;
	close $w;
	POSIX::_exit(0);
    }
    close $w;
    binmode $r;
    $self->{BORDERS_CHILD} = [ $pid, $r ];
    warn "started borders child process\n" if $debug{m};
}

sub read_borders {
    my $self = shift;
    my($pid, $r) = @{delete $self->{BORDERS_CHILD}};
    my $data = do { local $/; <$r> };
    close $r;
    waitpid $pid, 0;

script/greple  view on Meta::CPAN

    pairs @param;
};

my $file_code;
my $default_icode = 'utf8';	# default input encoding
my @default_icode_list = qw(euc-jp 7bit-jis);
my $output_code;
my $default_ocode = 'utf8';	# default output encoding

$output_code = $opt_ocode || $default_ocode;
binmode STDOUT, ":encoding($output_code)";

## show unused option characters
if ($opt_d{u}) {
    my $s = join('','0'..'9',"\n",'a'..'z',"\n",'A'..'Z',"\n");
    map { /\|([0-9a-zA-Z])\b/ && $s =~ s/$1/./ } @optargs;
    die $s;
}

## show man pages
if ($opt_man or $opt_show or $opt_path) {

script/greple  view on Meta::CPAN

open SAVESTDIN,  '<&', \*STDIN  or die "open: $!";
open SAVESTDOUT, '>&', \*STDOUT or die "open: $!";
open SAVESTDERR, '>&', \*STDERR or die "open: $!";

sub recover_stdin {
    open STDIN, '<&', \*SAVESTDIN or die "open: $!";
}
sub recover_stderr {
    open STDERR, '>&', \*SAVESTDERR or die "open: $!";
    binmode STDERR, ':encoding(utf8)';
}
sub recover_stdout {
    close STDOUT;
    open STDOUT, '>&', \*SAVESTDOUT or die "open: $!";
}
sub close_stdout {
    close SAVESTDOUT;
    close STDOUT;
}

script/greple  view on Meta::CPAN

	if (not defined $content) {
	    if ($opt_error eq 'fatal') {
		die "ABORT on $current_file\n";
	    }
	    if ($opt_error ne 'retry') {
		warn "SKIP $current_file\n" if $opt_warn{skip};
		next FILE;
	    }

	    # Try again
	    binmode STDIN, ':raw';
	    seek STDIN, 0, 0 or do {
		warn "SKIP $current_file (not seekable)\n"
		    if $opt_warn{skip};
		next FILE;
	    };
	    $content = $slurp->();
	    if (not defined $content) {
		warn "SKIP* $current_file\n" if $opt_warn{skip};
		next FILE;
	    }
	    warn "RETRY $current_file\n" if $opt_warn{retry};
	    $stat{read_retry}++;
	    binmode STDOUT, ':raw';
	}

	my $matched = grep_data(\$content);

	$stat{match_effective} += $matched;
	$stat{file_searched}++;
	$stat{length} += length $content;
    } continue {
	close STDIN; # wait;	# wait for 4.019 or earlier?
	# recover STDIN for opening '-' and some weird command which needs
	# STDIN opened (like unzip)
	recover_stdin;
	binmode STDOUT, ":encoding($output_code)";
    }
}

sub usage {
    pod2usage(-verbose => 0, -exitval => "NOEXIT");

    my $quote = qr/[\\(){}\|\*?]/;
    for my $bucket ($rcloader->buckets) {
	my $module = $bucket->module;
	print "    $module options:\n";

script/greple  view on Meta::CPAN

		warn "$file: $!\n" unless -l $file;
		next;
	    };
	}

	if (my @filters = $filter_d->get_filters($file)) {
	    push_input_filter({ &FILELABEL => $file }, @filters);
	}

	if ($file_code eq 'binary') {
	    binmode STDIN, ":raw";
	} else {
	    binmode STDIN, ":encoding($file_code)";
	}

	return $file;
    }
    undef;
}

######################################################################

sub grep_data {

t/runner/Runner.pm  view on Meta::CPAN

use IO::File;

sub run {
    my $obj = shift;
    use IO::File;
    my $pid = (my $fh = new IO::File)->open('-|') // die "open: $@\n";
    if ($pid == 0) {
	if (my $stdin = $obj->{STDIN}) {
	    open STDIN, "<&=", $stdin->fileno or die "open: $!\n";
	    $stdin->fcntl(F_SETFD, 0) or die "fcntl F_SETFD: $!\n";
	    binmode STDIN, ':encoding(utf8)';
	}
	open STDERR, ">&STDOUT";
	$obj->execute;
	exit 1;
    }
    $obj->{STDIN} = undef;
    binmode $fh, ':encoding(utf8)';
    $obj->{stdout} = do { local $/; <$fh> };
    my $child = wait;
    $child != $pid and die "child = $child, pid = $pid";
    $obj->{pid} = $pid;
    $obj->{result} = $?;
    $obj;
}

sub status {
    my $obj = shift;

t/runner/Runner.pm  view on Meta::CPAN

}

*result = \&stdout; # for backward compatibility

sub setstdin {
    my $obj = shift;
    my $data = shift;
    my $stdin = $obj->{STDIN} //= do {
	my $fh = new_tmpfile IO::File or die "new_tmpfile: $!\n";
	$fh->fcntl(F_SETFD, 0) or die "fcntl F_SETFD: $!\n";
	binmode $fh, ':encoding(utf8)';
	$fh;
    };
    $stdin->seek(0, 0)  or die "seek: $!\n";
    $stdin->truncate(0) or die "truncate: $!\n";
    $stdin->print($data);
    $stdin->seek(0, 0)  or die "seek: $!\n";
    $obj;
}

##