

>From the keyboard of [email-masked] (Greg Frazier):
:Just to display my ignorance, doesn't <> do globbing in perl?
:Or is there a difference between "filename globbing" and
:"shell globbing"?

Sure, <shglobexpr> does globbing, and it often works.  However, 

    @catted = </usr/man/cat*/*.*>;

will probably not be what you're wanting: it blows up on my 
system because I have too many catpages.  

One thing you could do is always call &'glob(), so it will try the 
shell first for speed and only use perl if it must.

The {} implementation I sent out isn't right either.
It works better in the following.  

--tom

package glob;

# tom christiansen <[email-masked]>
#
# do shell or perl globbing without resorting
# to the shell, which might blow up.
#
# set $glob'debug for trace information.
#
# SHglob recognizes ~user and /usr/man/{man,cat}*/*tty*.* notations.
#
# (albeit somewhat less robustly than does the shell: you can't
#  generate non-existent filenames with /{man,cat}/ stuff.)
#
# entry points:
#
#       glob    : try perl glob, go to SHglob if it blows up
#       SHglob  : use perl only for sh-style globbing
#       REglob  : use full perl regexps

sub main'glob { 
    local($expr) = @_;
    local(@files);

    $? = 0;
    open(SAVERR, ">&STDERR"); close(STDERR);  # suppress args too long
    @files = <${expr}>;
    open(STDERR, ">&SAVERR"); close SAVERR;   # restore
    if ($?) {
	print STDERR "shell glob blew up on $expr\n" if $debug;
	@files = &'SHglob($expr);
    }
    @files;
}

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

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

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

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

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

    return sort @retlist;
} 

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

    $haveglobbed = 0;

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

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

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

    @retlist = &expand(@dirs);

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

    sort @retlist;
}

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

    unless ($haveglobbed || $thisdir =~ /([^\\]?)[?.*{[+\\]/ && $1 ne '\\') {
	@retlist = ($thisdir);
    } else {
	unless (opendir(DIR,$dir)) {
	    warn "glob: 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;
    } 

    @retlist;
} 

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

    if (!$user) {
	return $ENV{'HOME'} 		if $ENV{'HOME'};
	return $ENV{'LOGDIR'} 		if $ENV{'LOGDIR'};
	unless ($user = $ENV{'USER'}) {
	    @pwent = getpwnam($>);  # don't even consider using getlogin
	    $homedir{$user = $pwent[0]} = $pwent[7];
	} 
	warn "glob'homedir: who are you, user #$>?" 
	    if $debug && !$user;
    } 
    unless (defined $homedir{$user}) {
	if (@pwent = getpwnam($user)) {
	    $homedir{$user} = $pwent[7];
	} else {
	    warn "glob'homedir: who is user $user?\n" if $debug;
	    ### $homedir{$user} = '/';
	}
    }
    $homedir{$user};
} 

1;