package FastGlob;

package FastGlob;

=head1 NAME

FastGlob - A faster glob() implementation

=head1 SYNOPSIS

use FastGlob qw(glob);
@list = &glob('*.c');

=head1 DESCRIPTION

This module implements globbing in perl, rather than forking a csh.
This is faster than the built-in glob() call, and more robust (on
many platforms, csh chokes on C<echo *> if too many files are in the
directory.)

There are several module-local variables that can be set for
alternate environments, they are listed below with their (UNIX-ish)
defaults.

$FastGlob::dirsep = '/'; # directory path separator
$FastGlob::rootpat = '\A\Z'; # root directory prefix pattern
$FastGlob::curdir = '.'; # name of current directory in dir
$FastGlob::parentdir = '..'; # name of parent directory in dir
$FastGlob::hidedotfiles = 1; # hide filenames starting with .

So for MS-DOS for example, you could set these to:

$FastGlob::dirsep = '\\'; # directory path separator
$FastGlob::rootpat = '[A-Z]:'; # <Drive letter><colon> pattern
$FastGlob::curdir = '.'; # name of current directory in dir
$FastGlob::parentdir = '..'; # name of parent directory in dir
$FastGlob::hidedotfiles = 0; # hide filenames starting with .

And for MacOS to:

$FastGlob::dirsep = ':'; # directory path separator
$FastGlob::rootpat = '\A\Z'; # root directory prefix pattern
$FastGlob::curdir = '.'; # name of current directory in dir
$FastGlob::parentdir = '..'; # name of parent directory in dir
$FastGlob::hidedotfiles = 0; # hide filenames starting with .

=head1 INSTALLATION

Copy this module to the Perl 5 Library directory.

=head1 COPYRIGHT

Copyright (c) 1997 Marc Mengel. All rights reserved.

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Marc Mengel E<lt>F<[email protected]>E<gt>

=cut

use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(&glob);
@EXPORT_OK = qw(dirsep rootpat curdir parentidr hidedotfiles);

use strict; # be good
no strict 'vars'; # ... but not *that* good

#
# recursively wildcard expand a list of strings
#

# platform specifics

$dirsep = '/';
$rootpat= '\A\Z';
$curdir = '.';
$parentdir = '..';
$hidedotfiles = 1;
$verbose = 0;

sub glob {
my($string) = $_[0];
my(@comps,@res,@list,$re);

# check for and do tilde expansion
if ( $string =~ /^\~([^${dirsep}]*)/ ) {

if ( $1 eq "" ) {
@list = getpwuid($<);
} else {
@list = getpwnam($1);
}
$string =~ s/^\~([^${dirsep}]*)/$list[7]/;
}

# if there's no wildcards, just return it
if ( ! $string =~ /(^|[^\\])[*?\[\]{}]/ ) {
return ($string);
}

# Make the glob into a regexp

# escape + , and |
$re = $string;
$re =~ s/[+.|]/\\$&/go;

# handle * and ?
$re =~ s/(\A|[^\\])\*/$1.*/go;
$re =~ s/(\A|[^\\])\?/$1./go;

# deal with {xxx,yyy,zzz} -> (xxx|yyy|zzz) (while works for nested...)
while ( $re =~ /\{([^\{\}]*)\}/) {
@altlist = split(',',$1);
$re =~ s/\{([^\{\}]*)\}/"(" . join("|", @altlist) . ")"/e;
}

# deal with dot files

if ( $hidedotfiles ) {
$re =~ s%(\A|${dirsep})\.\*%${1}([^.].*)?%go;
$re =~ s%(\A|${dirsep})\.%${1}[^.]?%go;
}

# debugging

print "regexp is $re\n" if ($verbose);

# now split it into directory components

@comps = split( ${dirsep}, ${re} );

if ( $comps[0] =~ /${rootpat}/ ) {
shift(@comps);
@res = &recurseglob( "$&$dirsep", "$&$dirsep" , @comps );
} else {
@res = &recurseglob( $curdir, '' , @comps );
}

return sort(@res);
}

sub recurseglob {
my($dir, $dirname, @comps) = @_;
my(@res) = ();
my($re, $anymatches, @names, $string);

if ( $#comps == -1 ) {

# boottom of recursion, just return the path
chop($dirname); # always has gratiutous trailning slash
@res = ($dirname);

} else {

$re = '\A' . shift(@comps) . '\Z';

# slurp in the directory
opendir(HANDLE, $dir);
@names = readdir(HANDLE);
closedir(HANDLE);

# look for matches, and if you find one, glob the rest of the
# components. We eval the loop so the regexp gets compiled in,
# making searches on large directories faster.

$anymatches = 0;
$string = <<EOF;
foreach \$name (\@names) {
if ( \$name =~ /$re/o ) {
if ( \$name ne "$curdir" && \$name ne "$parentdir") {
unshift(\@res, &recurseglob( "$dir$dirsep\$name",
"$dirname\$name$dirsep",
\@comps ));
} elsif ( $#comps == -1 ) {
unshift(\@res, "$dirname\$name" );
}
\$anymatches = 1;
}
}
EOF
print "evaling: $string\n" if ($verbose);
eval $string;
}
return @res;
}

sub globtest {
my(@t0, @t1, $udiffm, $sdiffm, $udiffg, $sdiffg, @list);
local($,);

$, = " ";
while (<>) {
chomp;

@t0 = times();
@list = &glob($_);
@t1 = times();
$udiffm = ($t1[0] + $t1[2]) - ($t0[0] + $t0[2]);
$sdiffm = ($t1[1] + $t1[3]) - ($t0[1] + $t0[3]);
print "@list\n";

@t0 = times();
@list = glob($_);
@t1 = times();
$udiffg = ($t1[0] + $t1[2]) - ($t0[0] + $t0[2]);
$sdiffg = ($t1[1] + $t1[3]) - ($t0[1] + $t0[3]);
print "@list\n";

print "mine: [${udiffm}u\t${sdiffm}s]\n";
print "glob: [${udiffg}u\t${sdiffg}s]\n";
}
}

1;
__END__