

>From the keyboard of [email-masked] (Bob Mende Pie):
:   Does anyone have a perl routine that does shell globbing.   I need to do
:this and dont want to reinvent the wheel.

Here's one I sometimes use.  It looks funny now, and may not be
the most recent version I've posted.  Then again, it might
just be funny anyway.

--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:
#	tglob
#	glob.pl
# This archive created: Tue Jun 16 16:47:56 1992
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'tglob'" '(414 characters)'
if test -f 'tglob'
then
	echo shar: "will not over-write existing file 'tglob'"
else
sed 's/^	X//' << \SHAR_EOF > 'tglob'
	X#!/usr/bin/perl
	X
	Xrequire 'glob.pl';
	X
	X$[ = 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$glob'debug = 1;
	X
	Xfor ( print "glob> "; <STDIN>; print "glob> ") {
	X    chop;
	X    @list = &$glob($_);
	X    for ($i = $[; $i <= $#list; $i++) {
	X	printf "%3d %s\n", $i,$list[$i];
	X    } 
	X} 
SHAR_EOF
if test 414 -ne "`wc -c < 'tglob'`"
then
	echo shar: "error transmitting 'tglob'" '(should have been 414 characters)'
fi
chmod 775 'tglob'
fi
echo shar: "extracting 'glob.pl'" '(2867 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
	X# tom christiansen <[email-masked]>
	X#
	X# do shell or perl globbing without resorting
	X# to the shell, which might blow up.
	X#
	X# set $glob'debug for trace information.
	X#
	X# SHglob recognizes ~user and /usr/man/{man,cat}*/* notations.
	X# (albeit somewhat less robustly than does the shell.)
	X#
	X#
	X# entry points:
	X#
	X#       glob    : try perl glob, go to SHglob if it blows up
	X#       SHglob  : use perl only for sh-style globbing
	X#       REglob  : use full perl regexps
	X
	X
	Xsub main'SHglob {
	X    local($_) = @_;
	X    local(@retlist) = ();
	X    local($pre, $alt, $post);
	X
	X    printf "SHglob: globbing $_\n" if $debug;
	X
	X    s/([.+\\])/\\$1/g;
	X    s/\*/.*/g;
	X    s/\?/./g;
	X
	X    while ( ($pre, $alt, $post) = /^(.*)\{([^{]*)\}(.*)$/ ) {
	X	print "got $alt\n";
	X	$alt =~ s/,/|/g;
	X	$_ = "$pre($alt)$post";
	X    } 
	X
	X    for (split(' ')) {
	X	push(@retlist, &'REglob($_));
	X    } 
	X
	X    return sort @retlist;
	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    local($[);
	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[$[] eq '') {
	X	$dirs[0] = '/' unless $dirs[0] =~ m!^\.{1,2}$!;
	X    } else {
	X	unshift(@dirs, '.');
	X	$relative = 1;
	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 sort @retlist;
	X}
	X
	Xsub expand {
	X    local($dir, $thisdir, @rest) = @_;
	X    local($nextdir);
	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	    $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    @retlist;
	X} 
	X
	X
	Xsub homedir {
	X    local($user) = @_;
	X    # package global %homedir
	X
	X    if (!$user) {
	X	return $ENV{'HOME'} 		if $ENV{'HOME'};
	X	$user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwnam($>))[$[];
	X	unless ($user) {
	X	    warn "glob'homedir: who are you, user #$>?" if $debug;
	X	    return '/';
	X	}
	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
	X
	X1;
SHAR_EOF
if test 2867 -ne "`wc -c < 'glob.pl'`"
then
	echo shar: "error transmitting 'glob.pl'" '(should have been 2867 characters)'
fi
chmod 664 'glob.pl'
fi
exit 0
#	End of shell archive