在使用了20年的老文件系统和unix命令无法处理奇数文件名之后，我决定用 Perl 6 脚本代替 find /somewhere -type f | xargs -P 10 -n 1 do-stuff。
第一步是遍历一个目录树。我并不需要保留一个路径列表，但肯定要并行运行一些东西。在一个线程中生成一个 supply 似乎是一个合理的事情。
start my $s = supply {
for '/snapshots/home-2019-01-29/' {
emit .IO if (.IO.f & ! .IO.l);
.IO.dir()».&?BLOCK if (.IO.d & ! .IO.l);
CATCH { default { put BOLD .Str } }
}
}
{
my @files;
react whenever $s {
@files.push: $_;
}
say +@files;
say now - ENTER now;
}
递归是用 .&?BLOCK 调用主题上的 for 块来完成的。它的时间很短，速度很慢。200891个文件需要21.3s–find需要0.296s。
操作系统不会是这里的瓶颈，所以也许线程会有帮助。不过我不想用文件系统的请求来压倒操作系统。内置的 Telemetry 模块可以告诉我们在任何给定的时间内有多少个工作线程正在他们的手上。如果我们使用 Promise 手动启动 worker，我们可以决定在 worker 还处于空闲状态时避免线程。
sub recurse(IO() $_){
my @ret;
@ret.push: .Str if (.IO.f & ! .IO.l);
if (.IO.d & ! .IO.l) {
if Telemetry::Instrument::ThreadPool::Snap.new<gtq> > 4 {
@ret.append: do for .dir() { recurse($_) }
} else {
@ret.append: await do for .dir() {
Promise.start({ recurse($_) })
}
}
}
CATCH { default { put BOLD .Str } }
@ret.Slip
}
{
say +recurse('/snapshots/home-2019-01-29');
say now - ENTER now;
}
这需要7.65s什么是一个很大的进步，但仍然差20年C实现的性能好几条街。还可以找到可以做同样的和更多的单CPU核心，而不是产生 ~800％ 的负载。
在 Rakudo 源码中摸索，可以清楚地看到原因。有大量的 IO::Path 对象被创建，c 字符串被连接，只是为了把这些 c 字符串拆开，交给一些 VM-opcodes。我想要的只是我可以调用 open 的绝对路径。我们必须更深入地研究!
use nqp;
my @files;
my @dirs = '/snapshots/home-2019-01-29';
while @dirs.shift -> str $dir {
my Mu $dirh := nqp::opendir(nqp::unbox_s($dir));
while my str $name = nqp::nextfiledir($dirh) {
next if $name eq '.' | '..';
my str $abs-path = nqp::concat( nqp::concat($dir, '/'), $name);
next if nqp::fileislink($abs-path);
@files.push: $abs-path if nqp::stat($abs-path, nqp::const::STAT_ISREG);
@dirs.push: $abs-path if nqp::stat($abs-path, nqp::const::STAT_ISDIR);
}
CATCH { default { put BOLD .Str, ' ⟨', $dir, '⟩' } }
nqp::closedir($dirh);
}
say +@files; say now - ENTER now;
而这在只有1个核心的情况下，2.58s就完成了，在文件手数不多的情况下，应该会有更好的发挥。虽然还是比find慢9倍，但是可以用。把它包装成一个 supply 是另一天的任务。
所以目前来说–如果你想要快，你需要 nqp。
更新：我们需要检查当前等待的 workers，而不是 spawned workers 的数量。例子改成了 Snap.new<gtq>。
by gfldex