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<mengel@fnal.gov>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__