Path: utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!uunet!convex!convex.COM
From: tchrist@convex.COM (Tom Christiansen)
Newsgroups: comp.lang.perl
Subject: Re: Globbing
Message-ID: <100328@convex.convex.com>
Date: 28 Feb 90 19:39:40 GMT
References: <15209@bfmny0.UU.NET> <100306@convex.convex.com>
Sender: news@convex.com
Reply-To: tchrist@convex.COM (Tom Christiansen)
Organization: CONVEX Software Development, Richardson, TX
Lines: 205


Here's a recursive glob package complete with SHglob and REglob.
It also handles ~foo constructions.  The only problem is it 
dumps core on most interesting recursive uses.  Hopefully Larry's
recursion fix will make these problems go away.  If he can make 
it work for "/usr/m*/man?" (for the SHglob) without dumping core,
I'll be happy.  There's a testing program for playing with the
package.

--tom

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	testglob
#	glob.pl
# This archive created: Wed Feb 28 13:42:22 1990
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'testglob'" '(686 characters)'
if test -f 'testglob'
then
	echo shar: "will not over-write existing file 'testglob'"
else
sed 's/^	X//' << \SHAR_EOF > 'testglob'
	X#!/usr/bin/perl
	X
	Xsub source {
	X    local($file) = @_;
	X    local($return) = 0;
	X
	X    $return = do $file;
	X    die "couldn't do \"$file\": $!" unless defined $return;
	X    die "couldn't parse \"$file\": $@" if $@;
	X    die "couldn't run \"$file\"" unless $return;
	X}
	X
	X&source('glob.pl');
	X
	X$glob'debug = 1;
	X
	XSTYLE: {
	X    print "Glob style (either RE or SH)? ";
	X    $style = <STDIN>;
	X    redo STYLE unless $style =~ /^\s*(re|sh)/i;
	X    $glob = ($style =~ /^\s*re/i) ? 'REglob' : 'SHglob';
	X}
	X
	X
	Xfor ( print "glob> "; <STDIN>; print "glob> ") {
	X    chop;
	X    @list = &$glob($_);
	X    printf "Globbed %d entries\n", $#list+1;
	X    for ($i = 0; $i <= $#list; $i++) {
	X	print "$i $list[$i]\n";
	X    } 
	X} 
	X
SHAR_EOF
if test 686 -ne "`wc -c < 'testglob'`"
then
	echo shar: "error transmitting 'testglob'" '(should have been 686 characters)'
fi
chmod 775 'testglob'
fi
echo shar: "extracting 'glob.pl'" '(2267 characters)'
if test -f 'glob.pl'
then
	echo shar: "will not over-write existing file 'glob.pl'"
else
sed 's/^	X//' << \SHAR_EOF > 'glob.pl'
	Xpackage glob;
	X
	Xsub main'SHglob {
	X    local($expr) = @_;
	X
	X    printf "SHglob: globbing $expr\n" if $debug;
	X
	X    $expr =~ s/([^\\]?)([.{+\\])/$1\\$2/g;
	X    $expr =~ s/\*/.*/g;
	X    $expr =~ s/\?/./g;
	X
	X    return &main'REglob($expr);
	X} 
	X
	Xsub main'REglob {
	X    local($path) = @_;
	X    local($_);
	X    local(@retlist) = ();
	X    local($root,$expr,$pos);
	X    local($relative) = 0;
	X    local(@dirs);
	X    local($user);
	X
	X    $haveglobbed = 0;
	X
	X    @dirs = split(/\/+/, $path);
	X
	X    if ($dirs[0] =~ m!~(.*)!) {
	X	$dirs[0] = &homedir($1);
	X	return @retlist unless $dirs[0];
	X    } elsif ($dirs[0] eq '') {
	X	$dirs[0] = '/' unless $dirs[0] =~ m!^.{1,2}$!;
	X    } else {
	X	unless ($dirs[0] =~ m!^.{1,2}$!) {
	X	    unshift(@dirs, '.');
	X	    $relative = 1;
	X	}
	X    } 
	X
	X    printf "REglob: globbing %s\n", join('/',@dirs) if $debug;
	X
	X    @retlist = &expand(@dirs);
	X
	X    for (@retlist) {
	X	if ($relative) {
	X	    s!^\./!!o;
	X	}
	X	s!/{2,}!/!g;
	X    } 
	X
	X    return @retlist;
	X}
	X
	Xsub expand {
	X    local($dir, $thisdir, @rest) = @_;
	X    local($nextdir);
	X    local($_);
	X    local(@retlist) = ();
	X    local(*DIR);
	X
	X    unless ($haveglobbed || $thisdir =~ /([^\\]?)[?.*{[+\\]/ && $1 ne '\\') {
	X	@retlist = ($thisdir);
	X    } else {
	X	unless (opendir(DIR,$dir)) {
	X	    warn "glob: can't opendir $dir: $!\n" if $debug;
	X	} else {
	X		@retlist = grep(/^$thisdir$/,readdir(DIR));
	X		@retlist = grep(!/^\./, @retlist) unless $thisdir =~ /^\\\./;
	X		@retlist = sort @retlist;
	X		$haveglobbed++;
	X	} 
	X	closedir DIR;
	X    } 
	X
	X    for (@retlist) {
	X	$_ = $dir . '/' . $_;
	X    }
	X
	X    if ($nextdir = shift @rest) {
	X	local(@newlist) = ();
	X	for (@retlist) {
	X	    push(@newlist,&expand($_,$nextdir,@rest));
	X	} 
	X	@retlist = @newlist;
	X    } 
	X
	X    return @retlist;
	X} 
	X
	Xsub homedir {
	X    local($user) = @_;
	X    local(@pwent);
	X    # global %homedir
	X
	X    if (!$user) {
	X	return $ENV{'HOME'} 		if $ENV{'HOME'};
	X	($user = $ENV{'USER'})  	|| 
	X	    ($user = getlogin) 		|| 
	X	    (($user) = getpwnam($>));
	X	warn "glob'homedir: who are you, user #$>?" unless $user;
	X	return '/';
	X    } 
	X    unless (defined $homedir{$user}) {
	X	if (@pwent = getpwnam($user)) {
	X	    $homedir{$user} = $pwent[$#pwent - 1];
	X	} else {
	X	    warn "glob'homedir: who are you, user #$>?" unless $user;
	X	    $homedir{$user} = '/';
	X	}
	X    }
	X    return $homedir{$user};
	X} 
	X
	X1;
SHAR_EOF
if test 2267 -ne "`wc -c < 'glob.pl'`"
then
	echo shar: "error transmitting 'glob.pl'" '(should have been 2267 characters)'
fi
chmod 664 'glob.pl'
fi
exit 0
#	End of shell archive