#!/usr/local/bin/perl
package FastGlob;
require 5.005;
# ABSTRACT: A faster glob() implementation
BEGIN {
our $VERSION = '1.5'; # VERSION: generated by DZP::OurPkgVersion
}
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(&glob);
@EXPORT_OK = qw(dirsep rootpat curdir parentidr hidedotfiles);
use 5.004;
use strict; # be good
# platform specifics
our $dirsep = '/';
our $rootpat= '\A\Z';
our $curdir = '.';
our $parentdir = '..';
our $hidedotfiles = 1;
our $verbose = 0;
#
# recursively wildcard expand a list of strings
#
sub glob($) {
my @res;
my $part;
my $found1;
my $out;
my $bracepat = qr(\{([^\{\}]*)\});
# deal with {xxx,yyy,zzz}
@res = ();
$found1 = 1;
while ($found1) {
$found1 = 0;
for (@_) {
if ( m{$bracepat} ) {
foreach $part (split(',',$1)) {
$out = $_;
$out =~ s/$bracepat/$part/;
push(@res, $out);
}
$found1 = 1;
} else {
push(@res, $_);
}
}
@_ = @res;
@res = ();
}
for (@_) {
# check for and do tilde expansion
if ( /^\~([^${dirsep}]*)/ ) {
my $usr = $1;
my $usrdir = ( ($1 eq "") ? getpwuid($<) : getpwnam($usr) )[7];
if ($usrdir ne "" ) {
s/^\~\Q$usr\E/$usrdir/;
push(@res, $_);
}
} else {
push(@res, $_);
}
}
@_ = @res;
@res = ();
for (@_) {
# if there's no wildcards, just return it
unless (/(^|[^\\])[*?\[\]{}]/) {
push (@res, $_);
next;
}
# Make the glob into a regexp
# escape + , and |
s/([+.|])/\\$1/go;
# handle * and ?
s/(?<!\\)(\*)/.*/go;
s/(?<!\\)(\?)/./go;
# deal with dot files
if ( $hidedotfiles ) {
s/(\A|$dirsep)\.\*/$1(?:[^.].*)?/go;
s/(\A|$dirsep)\./$1\[\^.\]/go;
s/(\A|$dirsep)\[\^([^].]*)\]/$1\[\^\\.$2\]/go;
}
# debugging
print "regexp is $_\n" if ($verbose);
# now split it into directory components
my @comps = split($dirsep);
if ( $comps[0] =~ /($rootpat)/ ) {
shift(@comps);
push(@res, &recurseglob( "$1$dirsep", "$1$dirsep" , @comps ));
}
else {
push(@res, &recurseglob( $curdir, '' , @comps ));
}
}
return sort(@res);
}
sub recurseglob($ $ @) {
my($dir, $dirname, @comps) = @_;
my(@res) = ();
my($re, $anymatches, @names);
if ( @comps == 0 ) {
# bottom of recursion, just return the path
chop($dirname); # always has gratiutous trailing slash
@res = ($dirname);
} elsif ($comps[0] eq '') {
shift(@comps);
unshift(@res, &recurseglob( "$dir$dirsep",
"$dirname$dirsep",
@comps ));
} 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;
print "component re is qr($re)\n" if ($verbose);
my $regex = qr($re);
foreach (@names) {
print "considering |$_|\n" if ($verbose);
if ( m{$regex} ) {
if ( $#comps > -1 ) {
unshift(@res, &recurseglob( "$dir$dirsep$_",
"$dirname$_$dirsep",
@comps ));
} else {
unshift(@res, "$dirname$_" );
}
$anymatches = 1;
}
}
}
return @res;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FastGlob - A faster glob() implementation
=head1 VERSION
version 1.5
=head1 SYNOPSIS
use FastGlob qw(glob);
my @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 AUTHOR
Marc Mengel <mengel@fnal.gov>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 1999 by Marc Mengel.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut