From: Tom Christiansen <tchrist@convex.COM>
Subject: Re: Perl-side globbing (was Re: Perl Shell...)
Originator: tchrist@pixel.convex.com
Date: Fri, 11 Dec 1992 21:20:55 GMT
Reply-To: tchrist@convex.COM (Tom Christiansen)
Organization: Convex Computer Corporation, Colorado Springs, CO
X-Disclaimer: This message was written by a user at CONVEX Computer
              Corp. The opinions expressed are those of the user and
              not necessarily those of CONVEX.

I've always used this...

--tom

###############################################################
# glob.pl by Tom Christiansen <tchrist@convex.com>
#
# globbing package for perl that doesn't blow up 
# due to shell arg list expansion limits because it
# uses its own readdir()s.
#
# entry points are:
#    &SHglob for shell expr globbing (like perl's <*>) 
#    &REglob for perl expr globbing
#
# set $glob'debug for trace and debug info
#
# extra features: ~user expansions and {f{u,oo}ba{r,z},gl{arch,ork}}
# (latter for SHglob only -- REglob can use perl's alternation)
###############################################################


package glob;

sub main'SHglob {
    local($_) = @_;
    local(@retlist) = ();
    local($pre, $alt, $post);

    printf "SHglob: globbing $_\n" if $debug;

    s/([.+\\])/\\$1/g;
    s/\*/.*/g;
    s/\?/./g;

    while ( ($pre, $alt, $post) = /^(.*)\{([^{]*)\}(.*)$/ ) {
        $alt =~ s/,/|/g;
        $_ = "$pre($alt)$post";
    }
    s/\(\|/(\\.|/g;
    s/\|\)/|\\.)/g;

    for (split(' ')) {
	push(@retlist, &main'REglob($_));
    } 

    sort @retlist;
} 

sub main'REglob {
    local($path) = @_;
    local($_);
    local(@retlist) = ();
    local($root,$expr,$pos);
    local($relative) = 0;
    local(@dirs);
    local($haveglobbed);

    @dirs = split(/\/+/, $path);

    if ($dirs[$[] =~ m!~(.*)!) {
	$dirs[$[] = &homedir($1);
	return @retlist unless $dirs[$[];
    } elsif ($dirs[$[] eq '') {
	$dirs[$[] = '/' unless $dirs[$[] =~ m!^\.{1,2}$!;
    } else {
	unshift(@dirs, '.');
	$relative = 1;
    } 

    print "REglob: globbing ", join('/',@dirs), "\n" if $debug;

    @retlist = &expand(@dirs);

    for (@retlist) {
	s!^\./!! if $relative;
	s!/{2,}!/!g;
    } 

    return sort @retlist;
}

sub expand {
    local($dir, $thisdir, @rest) = @_;
    local($nextdir);
    local($_);
    local(@retlist) = ();
    local(*DIR);

    print "glob'expand: $dir $thisdir @rest\n" if $debug;

    unless ($haveglobbed || $thisdir =~ /([^\\]?)[?.*{[+\\]/ && $1 ne '\\') {
	@retlist = ($thisdir);
    } else {
	unless (opendir(DIR,$dir)) {
	    warn "glob'expand: can't opendir $dir: $!\n" if $debug;
	} else {
		@retlist = grep(/^$thisdir$/,readdir(DIR));
		@retlist = grep(!/^\./, @retlist) unless $thisdir =~ /\\\./;
		$haveglobbed++;
	} 
	closedir DIR;
    } 

    for (@retlist) {
	$_ = $dir . '/' . $_;
    }

    if ($nextdir = shift @rest) {
	local(@newlist) = ();
	for (@retlist) {
	    push(@newlist,&expand($_,$nextdir,@rest));
	} 
	@retlist = @newlist;
    } 
    for (@retlist) { s#/./#/#g; }

    return @retlist;
} 

sub homedir {
    local($user) = @_;
    local(@pwent);
    # global %homedir

    if (!$user) {
	return $ENV{'HOME'} 		if $ENV{'HOME'};
	unless ($user = $ENV{'USER'}) {
	    @pwent = getpwnam($>);
	    $homedir{$user = $pwent[$[]} = $pwent[$#pwent-1];
	} 
	warn "glob'homedir: who are you, user #$>?" 
	    if $debug && !$user;
    } 
    unless (defined $homedir{$user}) {
	if (@pwent = getpwnam($user)) {
	    $homedir{$user} = $pwent[$#pwent - 1];
	} else {
	    warn "glob'homedir: who is user $user?\n" if $debug;
	    #$homedir{$user} = '/';
	}
    }
    $homedir{$user};
} 

1;

__END__
-- 
    Tom Christiansen      tchrist@convex.com      convex!tchrist


There are two ways to write error-free programs.  Only the third one works.
Newsgroups: comp.lang.perl