X:\database> perl -le "@foo = `dir /b ABC*`; print scalar @foo"
540
####
X:\database> perl -le "@foo = glob('ABC*'); print scalar @foo"
540
####
use strict;
use warnings;
use Benchmark;
use Cwd;
my $path = '\\\\big\unc\path\name';
my $wild = 'ABC*';
chdir($path);
my $cwd = cwd;
print $cwd, $/;
my $results =
timethese( 10,
{
'plglob' => sub { my @files = plglob($wild); die if not @files },
'rdglob' => sub { my @files = rdglob($wild); die if not @files },
'qxglob' => sub { my @files = qxglob($wild); die if not @files },
'fdglob' => sub { my @files = fdglob($wild); die if not @files }
} );
Benchmark::cmpthese( $results );
sub plglob
{
my $wild = shift;
return glob($wild);
}
sub rdglob
{
my $wild = shift;
opendir(DIR, '.') or return ();
my @files;
$wild = wildcard($wild);
while (defined($_ = readdir(DIR)))
{
push(@files, $_) if m{$wild};
}
closedir(DIR);
return @files;
}
sub qxglob
{
my $wild = shift;
my @files = `dir /b`;
chomp @files;
$wild = wildcard($wild);
@files = grep { m{$wild} } @files;
return @files;
}
sub fdglob
{
my $wild = shift;
use File::DosGlob;
my @files = DosGlob($wild);
return @files;
}
# turn a file mask like "ABC*.txt" into a regex like qr{ABC[^/\\]*\.txt}
# (yes, this is a really fragile bug-prone way to go!)
sub wildcard
{
my $wild = shift || '*';
$wild =~ s!\?![^\/\\]!g;
$wild =~ s!\*![^\/\\]*!g;
$wild =~ s!\\!\\\\!g;
$wild =~ s!\.!\\.!g;
$wild = qr{\A$wild\z};
return $wild;
}
####
Benchmark: timing 10 iterations of fdglob, plglob, qxglob, rdglob...
Rate qxglob fdglob rdglob plglob
qxglob 1.27e-002/s -- -100% -100% -100%
fdglob 3.44/s 26995% -- -35% -40%
rdglob 5.33/s 41871% 55% -- -7%
plglob 5.71/s 44893% 66% 7% --