view release on metacpan or  search on metacpan

lib/FastGlob.pm  view on Meta::CPAN

use Exporter ();
use Carp qw(carp);

our @ISA = qw(Exporter);
our @EXPORT = qw(glob);
our @EXPORT_OK = qw(dirsep rootpat curdir parentdir hidedotfiles);

# platform specifics — auto-detect Windows defaults

my $IS_WINDOWS = ( $^O eq 'MSWin32' );

our $dirsep       = $IS_WINDOWS ? '\\' : '/';
our $rootpat      = $IS_WINDOWS ? '[A-Za-z]:' : '\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 = ();
    }

    # skip empty patterns — CORE::glob returns nothing for them
    @_ = grep { defined $_ && $_ ne '' } @_;

    for (@_) {
    # check for and do  tilde expansion
    if ( /^\~([^\Q${dirsep}\E]*)/ ) {
        my $usr = $1;
        my $usrdir;
        if ( $usr eq "" ) {
            # ~ alone: try getpwuid, fall back to $HOME / $USERPROFILE
            $usrdir = eval { (getpwuid($<))[7] };
            if ( !defined $usrdir ) {
                $usrdir = defined $ENV{HOME} ? $ENV{HOME} : $ENV{USERPROFILE};
            }
        } else {
            # ~user: try getpwnam (not available on Windows)
            $usrdir = eval { (getpwnam($usr))[7] };
        }
        if ( defined $usrdir && $usrdir ne "" ) {
                s/^\~\Q$usr\E/$usrdir/;
        }
        # Always keep the entry — if expansion fails, preserve the
        # original pattern unchanged (consistent with CORE::glob)
        push(@res, $_);
    } else {
        push(@res, $_);
        }
    }
    @_ = @res;
    @res = ();

    for (@_) {
    # if there's no wildcards, just return it
        unless (/(?<!\\)[*?\[\]{}]/) {
        push (@res, $_);
        next;
        }

    # Split into directory components FIRST, before regex transformation.
    # This prevents regex escape sequences (e.g. \.) from being confused
    # with the directory separator on Windows where $dirsep is \.
    # On Windows, accept both / and \ as path separators in patterns.
    my @comps;
    if ( $IS_WINDOWS ) {
        @comps = split(m{[/\\]});
    } else {
        @comps = split(/\Q$dirsep\E/);
    }

    # Check for root pattern before transforming components
    my $is_rooted = ($comps[0] =~ /($rootpat)/);
    my $root_prefix = $is_rooted ? $1 : undef;

    # Transform each component into a regex
    for my $comp (@comps) {
        if ( $comp =~ /(?<!\\)[*?\[\]]/ ) {
        # Wildcard component: convert glob pattern to regex

        # escape regex metacharacters that are not glob syntax
        $comp =~ s/([+.|(){}\$])/\\$1/g;

        # convert POSIX [!...] negation to regex [^...]
        # Only convert when there are chars between ! and ] (avoid [!] -> [^] which is invalid)
        $comp =~ s/\[!(?=[^\]]+\])/[^/g;

        # handle * and ?
        $comp =~ s/(?<!\\)(\*)/.*/g;
        $comp =~ s/(?<!\\)(\?)/./g;

        } else {
        # Literal component: escape regex metacharacters

lib/FastGlob.pm  view on Meta::CPAN

    }
    }
    return @res;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

FastGlob - A faster glob() implementation

=head1 VERSION

version 1.6

=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 control platform-specific
behavior. On Windows (C<$^O eq 'MSWin32'>), these are automatically set
to appropriate values. On other platforms, UNIX defaults are used.
You can override them after loading the module if needed.

        # UNIX defaults (auto-detected):
        $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 .

        # Windows defaults (auto-detected on MSWin32):
        $FastGlob::dirsep = '\\';       # directory path separator
        $FastGlob::rootpat = '[A-Za-z]:';  # <Drive letter><colon> pattern
        $FastGlob::curdir = '.';        # name of current directory in dir
        $FastGlob::parentdir = '..';    # name of parent directory in dir
        $FastGlob::hidedotfiles = 1;    # hide filenames starting with .

For classic MacOS you would set:

        $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 .

Tilde expansion (C<~> and C<~user>) uses C<getpwuid>/C<getpwnam> on UNIX.
On Windows, C<~> falls back to C<$HOME> or C<$USERPROFILE>.

=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