[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / Parser.pm

#! /usr/local/bin/perl -w
package Psh::Parser;

use strict;

require Psh::OS;
require Psh::Util;
require Psh::Strategy;

sub T_END() { 0; }
sub T_WORD() { 1; }
sub T_PIPE() { 2; }
sub T_REDIRECT() { 3; }
sub T_BACKGROUND() { 4; }
sub T_OR() { 5; }
sub T_AND() { 6; }

sub T_EXECUTE() { 1; }

# ugly, ugly, but makes things faster

my %quotehash = qw|' ' " " q( ) qw( ) qq( ) ` `|;
my %quotedquotes = ();
my $def_quoteexp;
my $def_tokenizer= '(\\s+|\\|\\||\\&\\&|\||=>|->|;;|;|\\&|>>|>|<<|<|\\(|\\)|\\{|\\}|\\[|\\])';
my $nevermatches = "(?!a)a";


$def_quoteexp = $nevermatches;
foreach my $opener (keys %quotehash) {
	$def_quoteexp .= '|' . quotemeta($opener);
	$quotedquotes{$opener} = quotemeta($quotehash{$opener});
}

my $stdallinall= "^((?:[^\\\\]|\\\\.)*?)(?:$def_tokenizer|($def_quoteexp))(.*)\$";

if ($]>=5.005) {
	eval {
		$stdallinall= qr{$stdallinall}s;
	};
}

sub decompose {
    my ($delimexp,$line,$num,$keep,$unmatched) = @_;
	my @matches;

    if (!defined($delimexp)) { $delimexp = $def_tokenizer; }
	elsif ($delimexp eq ' ') { $delimexp='(\s+)'; }

    if (!defined($num)) { $num = -1; }
    if (!defined($keep)) { $keep = 1; }

    # Remember if delimexp came with any parenthesized subexpr, and
    # arrange for it to have exactly one so we know what each piece in
    # the match below means:

    my $saveDelimiters = 0;
    @matches = ('x' =~ m/$delimexp|(.)/);
    if (@matches > 2) {
		require Carp;
		Carp::carp("Delimiter regexp '$delimexp' in decompose may " .
		  "contain at most 1 ().");
		return undef;
    }
    if (@matches == 2) {
      $saveDelimiters = 1;
    } else {
      $delimexp = "($delimexp)";
    }

	return _decompose($line, "^((?:[^\\\\]|\\\\.)*?)(?:$delimexp|($def_quoteexp))(.*)\$", $keep, $num, $unmatched, $saveDelimiters-1);
}

sub _decompose
{
	my ( $line, $regexp, $keep, $num, $unmatched, $saveDelimiters)= @_;

	$saveDelimiters++;
    my @pieces = ('');
    my $startNewPiece = 0;
    my $freshPiece = 1;
    my $uquote = 0;
    while ($line) {
		if ($startNewPiece) {
			push @pieces, '';
		    $startNewPiece = 0;
		    $freshPiece = 1;
	    }
	    if (@pieces == $num) { last; }

	    # $delimexp is unparenthesized below because we have
	    # already arranged for it to contain exactly one backref ()
		my ($prefix,$delimiter,$quote,$rest) =
	      ($line =~ m/$regexp/s);
	    if (!$keep and defined($prefix)) {
			$prefix= remove_backslash($prefix);
	    }
	    if (defined($delimiter)) {
		    $pieces[$#pieces] .= $prefix;
		    if ($saveDelimiters) {
				if (length($pieces[$#pieces]) or !$freshPiece) {
					push @pieces, $delimiter;
				} else {
					$pieces[$#pieces] = $delimiter;
				}
			    $startNewPiece = 1;
		    } elsif (@pieces > 1 or $pieces[0]) {
		  	    $startNewPiece = 1;
		    }
		    $line = $rest;
	    } elsif (defined($quote)) {
			my ($restOfQuote,$remainder) = 
			  ($rest =~ m/^((?:[^\\]|\\.)*?)$quotedquotes{$quote}(.*)$/s);
			if (defined($restOfQuote)) {
				if (!$keep and
				    $quote ne "\'" and $quote ne 'q(') {
					$restOfQuote= remove_backslash($restOfQuote);
				}
				$pieces[$#pieces]= join('',$pieces[$#pieces],$prefix,
										$quote,$restOfQuote,
										$quotehash{$quote});
				$line = $remainder;
				$freshPiece = 0;
			} else { # can't find matching quote, give up
				$uquote = 1;
				last;
			}
	    } else { # nothing found, so remainder all one unquoted piece
			if (!$keep and length($line)) {
				$line= remove_backslash($line);
		    }
		    last;
	    }
    }
    if (length($line)) { $pieces[$#pieces] .= $line; }
    if (defined($unmatched)) { ${$unmatched} = $uquote; }
    return wantarray?@pieces:\@pieces;
}

sub incomplete_expr
{
    my ($line) = @_;
	return 0 unless $line=~/[\[{('"]/s;

    my $unmatch = 0;
	my @words= 	@{scalar(_decompose($line,$stdallinall, 1, undef, \$unmatch))};
    if ($unmatch) { return 2; }

    my @openstack = (':'); # : is used as a bottom marker here
    my %open_of_close = qw|) ( } { ] [ " '|;

    foreach my $word (@words) {
		next if length($word)!=1;
		if ($word eq '[' or $word eq '{' or $word eq '(' or $word eq '"' or
		    $word eq "\"") {
			push @openstack, $word;
		} elsif ($word eq ')' or $word eq '}' or $word eq ']' or $word eq '"' or
				 $word eq "\"") {
			my $open= $open_of_close{$word};
			my $curopen = pop @openstack;
			if ($open ne $curopen) {
				return -1;
			}
		}
    }
    if (scalar(@openstack) > 1) { return 1; }
    return 0;
}

#
# glob_expansion()
#
# LINE EXPANSIONS:
#
# If we're going to be a shell, let's act like a shell. The idea here
# is to provide expansion functions that individual evaluation
# strategies can use on the argument list to perform operations
# similar to the ones a shell argument list undergoes. Each of these
# functions should take a reference to an array of "words" and return
# a solid (to be conservative, as opposed to modifying in place) array of
# "expanded words".
#
# Bash defines eight types of expansion in its manpage: brace
# expansion, tilde expansion, parameter and variable expansion,
# command substitution, arithmetic expansion, word splitting,
# pathname expansion, and process expansion.
#
# Of these, arithmetic expansion makes no sense in Perl. Word
# splitting should happen "on the fly", i.e., the array returned by
# one of these functions might have more elements than the argument
# did. Since the perl builtin "glob" handles brace, tilde and pathname
# expansion, here's a glob_expansion function that covers all of
# those. Also a variable_expansion function that handles substituting
# in the values of Perl variables. That leaves only:
#
# TODO: command_expansion (i.e., backticks. For this,
# backticks would have to be added to decompose as a recognized quote
# character), process_expansion
#
# TODO: should some of these line-processing actions happen in a
# uniform way, or should things simply be left to each evaluation strategy
# as psh currently works?
#
# array glob_expansion (arrayref WORDS)
#
# For each element x of the array referred to by WORDS, such that x
# is not quoted, push glob(x) onto an array, and return the collected array.
#

sub glob_expansion
{
	my $arref= shift;
	my $join_char= shift;
	my @retval  = ();

	for my $word (@{$arref}) {
		if ($word =~ m/['"']/ # if it contains quotes
			or ($word !~ m/{.*}|\[.*\]|[*?~]/)) { # or no globbing characters
			push @retval, $word;  # don't try to glob it
		} else { 
			# Glob it. If anything happens, quote the
			# results so they won't be clobbbered later.
			my @results = Psh::OS::glob($word);
			if (scalar(@results) == 0) {
				@results = ($word);
			} elsif (scalar(@results)>1 or $results[0] ne $word) {
				foreach (@results) { $_ = "'$_'"; }
			}
			if( $join_char) {
				push @retval, join($join_char, @results);
			} else {
				push @retval, @results;
			}
		}
	}

	return @retval;
}

sub unquote {
	my $text= shift;

	if (substr($text,0,1) eq '\'' and
	    substr($text,-1,1) eq '\'') {
		$text= substr($text,1,-1);
	} elsif ( substr($text,0,1) eq "\"" and
			 substr($text,-1,1) eq "\"") {
		$text= substr($text,1,-1);
	} elsif (substr($text,0,1) eq "\\") {
		$text= substr($text,1);
	}
	return $text;
}

sub remove_backslash {
	my $text= shift;

	$text=~ s/\\t/\t/g;
	$text=~ s/\\n/\n/g;
	$text=~ s/\\r/\r/g;
	$text=~ s/\\f/\f/g;
	$text=~ s/\\b/\b/g;
	$text=~ s/\\a/\a/g;
	$text=~ s/\\e/\e/g;
	$text=~ s/\\(0[0-7][0-7])/chr(oct($1))/ge;
	$text=~ s/\\(x[0-9a-fA-F][0-9a-fA-F])/chr(oct($1))/ge;
	$text=~ s/\\(.)/$1/g;
	return $text;
}

sub ungroup {
	my $text= shift;
	if (substr($text,0,1) eq '(' and
	    substr($text,-1,1) eq ')') {
		return substr($text,1,-1);
	} elsif (substr($text,0,1) eq '{' and
			substr($text,-1,1) eq '}') {
		return substr($text,1,-1);
	}
	return $text;
}

sub parse_fileno {
	my $tmp= shift;
	my $default1= shift;
	my $default2= shift;
	
	my @tmp= split('=', $tmp);   # [out=in] - not supported fully yet
	if (@tmp>2) {
		return undef;
	}
	if (@tmp<2) {
		push @tmp, $default2;
	}
	if (@tmp==2 && !$tmp[0]) {
		$tmp[0]= $default1;
	}
	my @result=();
	foreach (@tmp) {
		no strict 'refs';
		if (lc($_) eq 'all') {
			$_=1;
		}
		if (/^\d+$/) {
			push @result, $_+0;
		} else {
			if (ref *{"$Psh::PerlEval::current_package\:\:$_"}{FILEHANDLE}) {
				push @result, fileno(*{"$Psh::PerlEval::current_package\:\:$_"});
			}
		}
	}
	return @result;
}

sub make_tokens {
	my $line= shift;
	my $splitonly= shift;
	my @tmpparts= @{scalar(_decompose($line,$stdallinall, 0))};
	return @tmpparts if $splitonly;

	# Walk through parts and combine parenthesized parts properly
	my @parts=();
	my $nestlevel=0;
	my @tmp=();
	foreach (@tmpparts) {
		if (length($_)==1) {
			if ($_ eq '[' or $_ eq '(' or $_ eq '{') {
				$nestlevel++;
			} elsif ($_ eq '}' or $_ eq ')' or $_ eq ']') {
				$nestlevel--;
			}
		}
		if ($nestlevel) {
			push @tmp, $_;
		} elsif (@tmp) {
			push @parts,join('',@tmp,$_);
			@tmp=();
		} else {
			push @parts, $_;
		}
	}

	my @tokens= ();
	my @t=();
	my $tmp;
	while( defined($tmp= shift @parts)) {
		if ($tmp eq '||' or $tmp eq '&&') {
			push @t, @tokens;
			push @t, [T_END],[$tmp eq '||'?T_OR:T_AND];
			@tokens=();
		}
		elsif ($tmp eq ';;') {
			push @tokens, [T_WORD,';'];
		}
		elsif( $tmp eq '|') {
			my @fileno=(1,0);
			if (@parts>0) {
				my $tmp= shift @parts;
				if ($tmp=~/^\[(.+?)\]$/) {
					my $tmp2= $1;
					if (lc($tmp2) eq 'all') {
						push @tokens, [T_REDIRECT, '>&', 2, 1];
					}
					@fileno= parse_fileno($tmp2,1,0);
					if (!@fileno) {
						print STDERR "Illegal syntax\n"; ## FIXME
						return undef;
					}
				} else {
					unshift @parts, $tmp;
				}
			}
			push @t, [T_REDIRECT, '>&', $fileno[0], 'chainout']; # needs to come first
			push @t, @tokens;
			push @t, [T_PIPE];
			@tokens=( [T_REDIRECT, '<&', $fileno[1], 'chainin']);
		} elsif( $tmp =~ /^(>>?)$/) {
			my $tmp= $1;

			my $file;
			my @fileno=(1,0);
			my $allflag=0;
			if (@parts>0) {
				my $tmp= shift @parts;
				if ($tmp=~/^\[(.+?)\]$/) {
					my $tmp2= $1;
					if (lc($tmp2) eq 'all') {
						$allflag=1;
					}
					@fileno= parse_fileno($tmp2,1,0);
					if (!@fileno) {
						print STDERR "Illegal syntax\n"; ## FIXME
						return undef;
					}
				} else {
					unshift @parts, $tmp;
				}
			}
			if ($fileno[1]==0) {
				while( @parts>0) {
					$file= shift @parts;
					last if( $file !~ /^\s+$/);
						$file='';
				}
				if( !$file or substr($file,0,1) eq '&') {
					Psh::Util::print_error_i18n('redirect_file_missing',
												$tmp,$Psh::bin);
					return undef;
				}
				push @tokens, [T_REDIRECT,$tmp,$fileno[0],unquote($file)];
				} else {
					push @tokens, [T_REDIRECT, '>&', @fileno];
				}
			if ($allflag) {
				push @tokens, [T_REDIRECT, '>&', 2, 1];
			}
		} elsif( $tmp eq '<') {
			my $file;
			my @fileno=(0,0);
			if (@parts>0) {
				my $tmp= shift @parts;
				if ($tmp=~/^\[(.+?)\]$/) {
					@fileno= parse_fileno($1,0,0);
					if (!@fileno) {
						print STDERR "Illegal syntax\n"; ## FIXME
						return undef;
					}
				}
				else {
					unshift @parts, $tmp;
				}
			}
			if ($fileno[0]==0) {
				while( @parts>0) {
					$file= shift @parts;
					last if( $file !~ /^\s+$/);
					$file='';
				}
				if( !$file or substr($file,0,1) eq '&') {
					Psh::Util::print_error_i18n('redirect_file_missing',
												$tmp,$Psh::bin);
					return undef;
				}
				push @tokens, [T_REDIRECT,'<',$fileno[1],unquote($file)];
			} else {
				push @tokens, [T_REDIRECT,'<&',$fileno[1],$fileno[0]];
			}
		} elsif( $tmp eq '&') {
			push @t, @tokens;
			push @t, [T_BACKGROUND],[T_END];
			@tokens=();
		} elsif( $tmp eq ';') {
			push @t, @tokens;
			push @t, [T_END];
			@tokens= ();
		} elsif ($tmp eq '`') {
			my $tmp='';
			while ( (my $tmp2= shift @parts) ne '`' ) {
				$tmp.=' '.$tmp2;
			}
			$tmp= Psh::OS::backtick($tmp);
			$tmp=~ s/\\/\\\\/g;
			$tmp=~ s/\"/\\\"/g;
			$tmp=~ s/\n/\\n/g;
			$tmp=~ s/\$/\\\$/g;
			$tmp=~ s/\@/\\\@/g;
			push @tokens, [T_WORD, join('','"', $tmp,'"')];
		} elsif( $tmp=~ /^\s+$/) {
		} else {
			push @tokens, [T_WORD,$tmp];
		}
	}
    push @t, @tokens;
	return @t;
}

sub parse_line {
	my $line= shift;
	my (@use_strats) = @_;

	return () if substr($line,0,1) eq '#';

	my ($lvl1,$lvl2,$lvl3);
	if (@use_strats) {
		($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_return_objects(@use_strats);
	} elsif (@Psh::temp_use_strats) {
		($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_return_objects(@Psh::temp_use_strats);
	} else {
		($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_strategy_list();
	}

	if (@$lvl1) {
		foreach my $strategy (@$lvl1) {
			my $how= eval {
				$strategy->applies(\$line);
			};
			if ($@) {
				print STDERR $@;
			} elsif ($how) {
				my $name= $strategy->name;
				Psh::Util::print_debug_class('s',
											 "[Using strategy $name: $how]\n");
				return ([ T_EXECUTE, 1, [$strategy, $how, [], [$line], $line ]]);
			}
		}
	}
	if (@$lvl2) {
		die "Level 2 Strategies currently not supported!";
	}
	if (@$lvl3) {
		my @tokens= make_tokens( $line);
		my @elements=();
		my $element;
		while( @tokens > 0) {
			$element=parse_complex_command(\@tokens,$lvl3);
			return undef if ! defined( $element); # TODO: Error handling
			push @elements, $element;
			if (@tokens > 0) {
				if ($tokens[0][0] == T_END) {
					shift @tokens;
				}
				if (@tokens > 0) {
					if ($tokens[0][0] == T_AND) {
						shift @tokens;
						push @elements, [ T_AND ];
					} elsif ($tokens[0][0] == T_OR) {
						shift @tokens;
						push @elements, [ T_OR ];
					}
				}
			}
		}
		return @elements;
	}
}

sub parse_complex_command {
	my $tokens= shift;
	my $strategies= shift;
	my $piped= 0;
	my $foreground = 1;
	return [ T_EXECUTE, $foreground, _subparse_complex_command($tokens,$strategies,\$piped,\$foreground,{})];
}

sub _subparse_complex_command {
	my ($tokens,$use_strats,$piped,$foreground,$alias_disabled)=@_;
	my @simplecommands= parse_simple_command($tokens,$use_strats, $piped,$alias_disabled,$foreground);

	while (@$tokens > 0 && $tokens->[0][0] == T_PIPE) {
		shift @$tokens;
		$$piped= 1;
		push @simplecommands, parse_simple_command($tokens,$use_strats,$piped,$alias_disabled,$foreground);
	}

	if (@$tokens > 0 && $tokens->[0][0] == T_BACKGROUND) {
		shift @$tokens;
		$$foreground = 0;
	}
	return @simplecommands;
}

sub parse_simple_command {
	my ($tokens,$use_strats,$piped,$alias_disabled,$foreground)=@_;
	my (@words,@options,@savetokens,@precom);
	my $opt={};

	my $firstwords=1;
	while (@$tokens > 0 and
		   ($tokens->[0][0] == T_WORD or
			$tokens->[0][0] == T_REDIRECT)) {
		my $token = shift @$tokens;
		if ($token->[0] == T_WORD) {
			if ($firstwords and
			    ($token->[1] eq 'noglob' or
				 $token->[1] eq 'noexpand' or
				 $token->[1] eq 'noalias')) {
				push @precom, $token;
				$opt->{$token->[1]}=1;
			} else {
				$firstwords=0;
				push @savetokens,$token;
				push @words, $token->[1];
			}
		} elsif ($token->[0] == T_REDIRECT) {
			push @options, $token;
		} else {
		}
	}

	if (%Psh::Support::Alias::aliases and
		!$opt->{noalias} and
	    $Psh::Support::Alias::aliases{$words[0]} and
	    !$alias_disabled->{$words[0]}) {
		my $alias= $Psh::Support::Alias::aliases{$words[0]};
		$alias =~ s/\'/\\\'/g;
		$alias_disabled->{$words[0]}=1;
		my @tmp= make_tokens($alias);
		unshift @tmp, @precom;
		shift @savetokens;
		push @tmp, @savetokens;
		push @tmp, @options;
		return _subparse_complex_command(\@tmp,$use_strats,$piped,$foreground,$alias_disabled);
	} elsif (substr($words[0],0,1) eq "\\") {
		$words[0]=substr($words[0],1);
	}

	my $line= join ' ', @words;
	local $Psh::current_options= $opt;
	foreach my $strat (@$use_strats) {
		my $how= eval {
			$strat->applies(\$line,\@words,$$piped);
		};
		if ($@) {
			print STDERR $@;
		}
		elsif ($how) {
			my $name= $strat->name;
			Psh::Util::print_debug_class('s',
										 "[Using strategy $name: $how]\n");
			return [ $strat, $how, \@options, \@words, $line, $opt];
		}
	}
	Psh::Util::print_error_i18n('clueless',$line,$Psh::bin);
	die '';
}

# TODO: right now this is pretty much of a hack. Could it be improved?
#        For example, 'print hello \n' on the command line gets double
#        quotes around hello and \n, so that it ends up doing
#        print("hello","\n") which looks nice but is a surprise to
#        bash users. Perhaps backslash escapes simply shouldn't be OK?

sub needs_double_quotes
{
	my ($word) = @_;

	return if !defined($word) or !$word;

	if ($word =~ m/[a-zA-Z]/                     # if it has some letters
		and $word =~ m!^(\\.|[$.:a-zA-Z0-9/.])*$!) { # and only these characters 
		return 1;                                # then double-quote it
	}

	return 0;
}


1;
__END__

=head1 NAME

  Psh::Parser - Perl Shell Parser

=head1 SYNOPSIS

  use Psh::Parser;

=head1 DESCRIPTION

=over 4

=item *

  array decompose(regexp DELIMITER, string LINE, int PIECES,
                  bool KEEP, hashref QUOTINGPAIRS,
                  scalarref UNMATCHED_QUOTE)

decompose is a cross between split() and
Text::ParseWords::parse_line: it breaks LINE into at most PIECES
pieces separated by DELIMITER, except that the hash given by the
reference QUOTINGPAIRS specifies pairs of quotes (each key is an
open quote which matches the corresponding value) which prevent
splitting on internal instances of DELIMITER, and negate the effect
of other quotes. The quoting characters are retained if KEEP is
true, discarded otherwise. Matches to the regexp METACHARACTERS
(outside quotes) are their own words, regardless of being delimited.
Backslashes escape the meanings of characters that might match
delimiters, quotes, or metacharacters.  Initial unquoted empty
pieces are suppressed. 

The regexp DELIMITER may contain a single back-reference parenthesis
construct, in which case the matches to the parenthesized
subexpression are also placed among the pieces, as with the
built-in split. METACHARACTERS may not contain any parenthesized
subexpression.

decompose returns the array of pieces. If UNMATCHED_QUOTE is
specified, 1 will be placed in the scalar referred to if LINE
contained an unmatched quote, 0 otherwise.

If PIECES is undefined, as many pieces as
necessary are used. KEEP defaults to 1. If QUOTINGPAIRS is
undefined, {"'" => "'", "\"" => "\""} is used, i.e. single and
double quotes are recognized. Supply a reference to an empty hash to
have no quoting characters. METACHARACTERS defaults to a regexp that
never matches.

EXAMPLE: if $line is exactly

echo fred(joe, "Happy Days", ' steve"jan ', "\"Oh, no!\"")

then decompose(' ', $line) should break it at the
following places marked by vertical bars: 

echo|fred(joe,|"Happy Days",|' steve"jan',|"\"Oh, no!\"")

=item *

  int incomplete_expr(string LINE)

Returns 2 if LINE has unmatched quotations. Returns -1 if LINE has
mismatched parens. Otherwise, returns 1 if LINE has an unmatched
open brace, parenthesis, or square bracket and 0 in all other
cases. Summing up, negative is a mismatch, 0 is all OK, and positive
is unfinished business. (Reasonably good, can be fooled with some
effort. I therefore have deliberately not taken comments into
account, which means you can use them to "unfool" this function, but
also that unmatched stuff in comments WILL fool this function.)

=item *

  string unquote( string word)

Removes quotes from a word and backslash escapes

=item *

  bool needs_double_quotes (string WORD)

Returns true if WORD needs double quotes around it to be interpreted
in a "shell-like" manner when passed to eval. This covers barewords,
expressions that just have \-escapes and $variables in them, and
filenames.

=back

=head1 AUTHOR

Various

=cut
Commit	Line	Data
86530b38 AT	1	#! /usr/local/bin/perl -w
	2	package Psh::Parser;
	3
	4	use strict;
	5
	6	require Psh::OS;
	7	require Psh::Util;
	8	require Psh::Strategy;
	9
	10	sub T_END() { 0; }
	11	sub T_WORD() { 1; }
	12	sub T_PIPE() { 2; }
	13	sub T_REDIRECT() { 3; }
	14	sub T_BACKGROUND() { 4; }
	15	sub T_OR() { 5; }
	16	sub T_AND() { 6; }
	17
	18	sub T_EXECUTE() { 1; }
	19
	20	# ugly, ugly, but makes things faster
	21
	22	my %quotehash = qw\|' ' " " q( ) qw( ) qq( ) ` `\|;
	23	my %quotedquotes = ();
	24	my $def_quoteexp;
	25	my $def_tokenizer= '(\\s+\|\\\|\\\|\|\\&\\&\|\\|\|=>\|->\|;;\|;\|\\&\|>>\|>\|<<\|<\|\\(\|\\)\|\\{\|\\}\|\\[\|\\])';
	26	my $nevermatches = "(?!a)a";
	27
	28
	29	$def_quoteexp = $nevermatches;
	30	foreach my $opener (keys %quotehash) {
	31	$def_quoteexp .= '\|' . quotemeta($opener);
	32	$quotedquotes{$opener} = quotemeta($quotehash{$opener});
	33	}
	34
	35	my $stdallinall= "^((?:[^\\\\]\|\\\\.)?)(?:$def_tokenizer\|($def_quoteexp))(.)\$";
	36
	37	if ($]>=5.005) {
	38	eval {
	39	$stdallinall= qr{$stdallinall}s;
	40	};
	41	}
	42
	43	sub decompose {
	44	my ($delimexp,$line,$num,$keep,$unmatched) = @_;
	45	my @matches;
	46
	47	if (!defined($delimexp)) { $delimexp = $def_tokenizer; }
	48	elsif ($delimexp eq ' ') { $delimexp='(\s+)'; }
	49
	50	if (!defined($num)) { $num = -1; }
	51	if (!defined($keep)) { $keep = 1; }
	52
	53	# Remember if delimexp came with any parenthesized subexpr, and
	54	# arrange for it to have exactly one so we know what each piece in
	55	# the match below means:
	56
	57	my $saveDelimiters = 0;
	58	@matches = ('x' =~ m/$delimexp\|(.)/);
	59	if (@matches > 2) {
	60	require Carp;
	61	Carp::carp("Delimiter regexp '$delimexp' in decompose may " .
	62	"contain at most 1 ().");
	63	return undef;
	64	}
65	if (@matches == 2) {
66	$saveDelimiters = 1;
67	} else {
68	$delimexp = "($delimexp)";
69	}
70
71	return _decompose($line, "^((?:[^\\\\]\|\\\\.)?)(?:$delimexp\|($def_quoteexp))(.)\$", $keep, $num, $unmatched, $saveDelimiters-1);
72	}
73
74	sub _decompose
75	{
76	my ( $line, $regexp, $keep, $num, $unmatched, $saveDelimiters)= @_;
77
78	$saveDelimiters++;
79	my @pieces = ('');
80	my $startNewPiece = 0;
81	my $freshPiece = 1;
82	my $uquote = 0;
83	while ($line) {
84	if ($startNewPiece) {
85	push @pieces, '';
86	$startNewPiece = 0;
87	$freshPiece = 1;
88	}
89	if (@pieces == $num) { last; }
90
91	# $delimexp is unparenthesized below because we have
92	# already arranged for it to contain exactly one backref ()
93	my ($prefix,$delimiter,$quote,$rest) =
94	($line =~ m/$regexp/s);
95	if (!$keep and defined($prefix)) {
96	$prefix= remove_backslash($prefix);
97	}
98	if (defined($delimiter)) {
99	$pieces[$#pieces] .= $prefix;
100	if ($saveDelimiters) {
101	if (length($pieces[$#pieces]) or !$freshPiece) {
102	push @pieces, $delimiter;
103	} else {
104	$pieces[$#pieces] = $delimiter;
105	}
106	$startNewPiece = 1;
107	} elsif (@pieces > 1 or $pieces[0]) {
108	$startNewPiece = 1;
109	}
110	$line = $rest;
111	} elsif (defined($quote)) {
112	my ($restOfQuote,$remainder) =
113	($rest =~ m/^((?:[^\\]\|\\.)?)$quotedquotes{$quote}(.)$/s);
114	if (defined($restOfQuote)) {
115	if (!$keep and
116	$quote ne "\'" and $quote ne 'q(') {
117	$restOfQuote= remove_backslash($restOfQuote);
118	}
119	$pieces[$#pieces]= join('',$pieces[$#pieces],$prefix,
120	$quote,$restOfQuote,
121	$quotehash{$quote});
122	$line = $remainder;
123	$freshPiece = 0;
124	} else { # can't find matching quote, give up
125	$uquote = 1;
126	last;
127	}
128	} else { # nothing found, so remainder all one unquoted piece
129	if (!$keep and length($line)) {
130	$line= remove_backslash($line);
131	}
132	last;
133	}
134	}
135	if (length($line)) { $pieces[$#pieces] .= $line; }
136	if (defined($unmatched)) { ${$unmatched} = $uquote; }
137	return wantarray?@pieces:\@pieces;
138	}
139
140	sub incomplete_expr
141	{
142	my ($line) = @_;
143	return 0 unless $line=~/[\[{('"]/s;
144
145	my $unmatch = 0;
146	my @words= @{scalar(_decompose($line,$stdallinall, 1, undef, \$unmatch))};
147	if ($unmatch) { return 2; }
148
149	my @openstack = (':'); # : is used as a bottom marker here
150	my %open_of_close = qw\|) ( } { ] [ " '\|;
151
152	foreach my $word (@words) {
153	next if length($word)!=1;
154	if ($word eq '[' or $word eq '{' or $word eq '(' or $word eq '"' or
155	$word eq "\"") {
156	push @openstack, $word;
157	} elsif ($word eq ')' or $word eq '}' or $word eq ']' or $word eq '"' or
158	$word eq "\"") {
159	my $open= $open_of_close{$word};
160	my $curopen = pop @openstack;
161	if ($open ne $curopen) {
162	return -1;
163	}
164	}
165	}
166	if (scalar(@openstack) > 1) { return 1; }
167	return 0;
168	}
169
170	#
171	# glob_expansion()
172	#
173	# LINE EXPANSIONS:
174	#
175	# If we're going to be a shell, let's act like a shell. The idea here
176	# is to provide expansion functions that individual evaluation
177	# strategies can use on the argument list to perform operations
178	# similar to the ones a shell argument list undergoes. Each of these
179	# functions should take a reference to an array of "words" and return
180	# a solid (to be conservative, as opposed to modifying in place) array of
181	# "expanded words".
182	#
183	# Bash defines eight types of expansion in its manpage: brace
184	# expansion, tilde expansion, parameter and variable expansion,
185	# command substitution, arithmetic expansion, word splitting,
186	# pathname expansion, and process expansion.
187	#
188	# Of these, arithmetic expansion makes no sense in Perl. Word
189	# splitting should happen "on the fly", i.e., the array returned by
190	# one of these functions might have more elements than the argument
191	# did. Since the perl builtin "glob" handles brace, tilde and pathname
192	# expansion, here's a glob_expansion function that covers all of
193	# those. Also a variable_expansion function that handles substituting
194	# in the values of Perl variables. That leaves only:
195	#
196	# TODO: command_expansion (i.e., backticks. For this,
197	# backticks would have to be added to decompose as a recognized quote
198	# character), process_expansion
199	#
200	# TODO: should some of these line-processing actions happen in a
201	# uniform way, or should things simply be left to each evaluation strategy
202	# as psh currently works?
203	#
204	# array glob_expansion (arrayref WORDS)
205	#
206	# For each element x of the array referred to by WORDS, such that x
207	# is not quoted, push glob(x) onto an array, and return the collected array.
208	#
209
210	sub glob_expansion
211	{
212	my $arref= shift;
213	my $join_char= shift;
214	my @retval = ();
215
216	for my $word (@{$arref}) {
217	if ($word =~ m/['"']/ # if it contains quotes
218	or ($word !~ m/{.}\|\[.\]\|[*?~]/)) { # or no globbing characters
219	push @retval, $word; # don't try to glob it
220	} else {
221	# Glob it. If anything happens, quote the
222	# results so they won't be clobbbered later.
223	my @results = Psh::OS::glob($word);
224	if (scalar(@results) == 0) {
225	@results = ($word);
226	} elsif (scalar(@results)>1 or $results[0] ne $word) {
227	foreach (@results) { $_ = "'$_'"; }
228	}
229	if( $join_char) {
230	push @retval, join($join_char, @results);
231	} else {
232	push @retval, @results;
233	}
234	}
235	}
236
237	return @retval;
238	}
239
240	sub unquote {
241	my $text= shift;
242
243	if (substr($text,0,1) eq '\'' and
244	substr($text,-1,1) eq '\'') {
245	$text= substr($text,1,-1);
246	} elsif ( substr($text,0,1) eq "\"" and
247	substr($text,-1,1) eq "\"") {
248	$text= substr($text,1,-1);
249	} elsif (substr($text,0,1) eq "\\") {
250	$text= substr($text,1);
251	}
252	return $text;
253	}
254
255	sub remove_backslash {
256	my $text= shift;
257
258	$text=~ s/\\t/\t/g;
259	$text=~ s/\\n/\n/g;
260	$text=~ s/\\r/\r/g;
261	$text=~ s/\\f/\f/g;
262	$text=~ s/\\b/\b/g;
263	$text=~ s/\\a/\a/g;
264	$text=~ s/\\e/\e/g;
265	$text=~ s/\\(0[0-7][0-7])/chr(oct($1))/ge;
266	$text=~ s/\\(x[0-9a-fA-F][0-9a-fA-F])/chr(oct($1))/ge;
267	$text=~ s/\\(.)/$1/g;
268	return $text;
269	}
270
271	sub ungroup {
272	my $text= shift;
273	if (substr($text,0,1) eq '(' and
274	substr($text,-1,1) eq ')') {
275	return substr($text,1,-1);
276	} elsif (substr($text,0,1) eq '{' and
277	substr($text,-1,1) eq '}') {
278	return substr($text,1,-1);
279	}
280	return $text;
281	}
282
283	sub parse_fileno {
284	my $tmp= shift;
285	my $default1= shift;
286	my $default2= shift;
287
288	my @tmp= split('=', $tmp); # [out=in] - not supported fully yet
289	if (@tmp>2) {
290	return undef;
291	}
292	if (@tmp<2) {
293	push @tmp, $default2;
294	}
295	if (@tmp==2 && !$tmp[0]) {
296	$tmp[0]= $default1;
297	}
298	my @result=();
299	foreach (@tmp) {
300	no strict 'refs';
301	if (lc($_) eq 'all') {
302	$_=1;
303	}
304	if (/^\d+$/) {
305	push @result, $_+0;
306	} else {
307	if (ref *{"$Psh::PerlEval::current_package\:\:$_"}{FILEHANDLE}) {
308	push @result, fileno(*{"$Psh::PerlEval::current_package\:\:$_"});
309	}
310	}
311	}
312	return @result;
313	}
314
315	sub make_tokens {
316	my $line= shift;
317	my $splitonly= shift;
318	my @tmpparts= @{scalar(_decompose($line,$stdallinall, 0))};
319	return @tmpparts if $splitonly;
320
321	# Walk through parts and combine parenthesized parts properly
322	my @parts=();
323	my $nestlevel=0;
324	my @tmp=();
325	foreach (@tmpparts) {
326	if (length($_)==1) {
327	if ($_ eq '[' or $_ eq '(' or $_ eq '{') {
328	$nestlevel++;
329	} elsif ($_ eq '}' or $_ eq ')' or $_ eq ']') {
330	$nestlevel--;
331	}
332	}
333	if ($nestlevel) {
334	push @tmp, $_;
335	} elsif (@tmp) {
336	push @parts,join('',@tmp,$_);
337	@tmp=();
338	} else {
339	push @parts, $_;
340	}
341	}
342
343	my @tokens= ();
344	my @t=();
345	my $tmp;
346	while( defined($tmp= shift @parts)) {
347	if ($tmp eq '\|\|' or $tmp eq '&&') {
348	push @t, @tokens;
349	push @t, [T_END],[$tmp eq '\|\|'?T_OR:T_AND];
350	@tokens=();
351	}
352	elsif ($tmp eq ';;') {
353	push @tokens, [T_WORD,';'];
354	}
355	elsif( $tmp eq '\|') {
356	my @fileno=(1,0);
357	if (@parts>0) {
358	my $tmp= shift @parts;
359	if ($tmp=~/^\[(.+?)\]$/) {
360	my $tmp2= $1;
361	if (lc($tmp2) eq 'all') {
362	push @tokens, [T_REDIRECT, '>&', 2, 1];
363	}
364	@fileno= parse_fileno($tmp2,1,0);
365	if (!@fileno) {
366	print STDERR "Illegal syntax\n"; ## FIXME
367	return undef;
368	}
369	} else {
370	unshift @parts, $tmp;
371	}
372	}
373	push @t, [T_REDIRECT, '>&', $fileno[0], 'chainout']; # needs to come first
374	push @t, @tokens;
375	push @t, [T_PIPE];
376	@tokens=( [T_REDIRECT, '<&', $fileno[1], 'chainin']);
377	} elsif( $tmp =~ /^(>>?)$/) {
378	my $tmp= $1;
379
380	my $file;
381	my @fileno=(1,0);
382	my $allflag=0;
383	if (@parts>0) {
384	my $tmp= shift @parts;
385	if ($tmp=~/^\[(.+?)\]$/) {
386	my $tmp2= $1;
387	if (lc($tmp2) eq 'all') {
388	$allflag=1;
389	}
390	@fileno= parse_fileno($tmp2,1,0);
391	if (!@fileno) {
392	print STDERR "Illegal syntax\n"; ## FIXME
393	return undef;
394	}
395	} else {
396	unshift @parts, $tmp;
397	}
398	}
399	if ($fileno[1]==0) {
400	while( @parts>0) {
401	$file= shift @parts;
402	last if( $file !~ /^\s+$/);
403	$file='';
404	}
405	if( !$file or substr($file,0,1) eq '&') {
406	Psh::Util::print_error_i18n('redirect_file_missing',
407	$tmp,$Psh::bin);
408	return undef;
409	}
410	push @tokens, [T_REDIRECT,$tmp,$fileno[0],unquote($file)];
411	} else {
412	push @tokens, [T_REDIRECT, '>&', @fileno];
413	}
414	if ($allflag) {
415	push @tokens, [T_REDIRECT, '>&', 2, 1];
416	}
417	} elsif( $tmp eq '<') {
418	my $file;
419	my @fileno=(0,0);
420	if (@parts>0) {
421	my $tmp= shift @parts;
422	if ($tmp=~/^\[(.+?)\]$/) {
423	@fileno= parse_fileno($1,0,0);
424	if (!@fileno) {
425	print STDERR "Illegal syntax\n"; ## FIXME
426	return undef;
427	}
428	}
429	else {
430	unshift @parts, $tmp;
431	}
432	}
433	if ($fileno[0]==0) {
434	while( @parts>0) {
435	$file= shift @parts;
436	last if( $file !~ /^\s+$/);
437	$file='';
438	}
439	if( !$file or substr($file,0,1) eq '&') {
440	Psh::Util::print_error_i18n('redirect_file_missing',
441	$tmp,$Psh::bin);
442	return undef;
443	}
444	push @tokens, [T_REDIRECT,'<',$fileno[1],unquote($file)];
445	} else {
446	push @tokens, [T_REDIRECT,'<&',$fileno[1],$fileno[0]];
447	}
448	} elsif( $tmp eq '&') {
449	push @t, @tokens;
450	push @t, [T_BACKGROUND],[T_END];
451	@tokens=();
452	} elsif( $tmp eq ';') {
453	push @t, @tokens;
454	push @t, [T_END];
455	@tokens= ();
456	} elsif ($tmp eq '`') {
457	my $tmp='';
458	while ( (my $tmp2= shift @parts) ne '`' ) {
459	$tmp.=' '.$tmp2;
460	}
461	$tmp= Psh::OS::backtick($tmp);
462	$tmp=~ s/\\/\\\\/g;
463	$tmp=~ s/\"/\\\"/g;
464	$tmp=~ s/\n/\\n/g;
465	$tmp=~ s/\$/\\\$/g;
466	$tmp=~ s/\@/\\\@/g;
467	push @tokens, [T_WORD, join('','"', $tmp,'"')];
468	} elsif( $tmp=~ /^\s+$/) {
469	} else {
470	push @tokens, [T_WORD,$tmp];
471	}
472	}
473	push @t, @tokens;
474	return @t;
475	}
476
477	sub parse_line {
478	my $line= shift;
479	my (@use_strats) = @_;
480
481	return () if substr($line,0,1) eq '#';
482
483	my ($lvl1,$lvl2,$lvl3);
484	if (@use_strats) {
485	($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_return_objects(@use_strats);
486	} elsif (@Psh::temp_use_strats) {
487	($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_return_objects(@Psh::temp_use_strats);
488	} else {
489	($lvl1,$lvl2,$lvl3)= Psh::Strategy::parser_strategy_list();
490	}
491
492	if (@$lvl1) {
493	foreach my $strategy (@$lvl1) {
494	my $how= eval {
495	$strategy->applies(\$line);
496	};
497	if ($@) {
498	print STDERR $@;
499	} elsif ($how) {
500	my $name= $strategy->name;
501	Psh::Util::print_debug_class('s',
502	"[Using strategy $name: $how]\n");
503	return ([ T_EXECUTE, 1, [$strategy, $how, [], [$line], $line ]]);
504	}
505	}
506	}
507	if (@$lvl2) {
508	die "Level 2 Strategies currently not supported!";
509	}
510	if (@$lvl3) {
511	my @tokens= make_tokens( $line);
512	my @elements=();
513	my $element;
514	while( @tokens > 0) {
515	$element=parse_complex_command(\@tokens,$lvl3);
516	return undef if ! defined( $element); # TODO: Error handling
517	push @elements, $element;
518	if (@tokens > 0) {
519	if ($tokens[0][0] == T_END) {
520	shift @tokens;
521	}
522	if (@tokens > 0) {
523	if ($tokens[0][0] == T_AND) {
524	shift @tokens;
525	push @elements, [ T_AND ];
526	} elsif ($tokens[0][0] == T_OR) {
527	shift @tokens;
528	push @elements, [ T_OR ];
529	}
530	}
531	}
532	}
533	return @elements;
534	}
535	}
536
537	sub parse_complex_command {
538	my $tokens= shift;
539	my $strategies= shift;
540	my $piped= 0;
541	my $foreground = 1;
542	return [ T_EXECUTE, $foreground, _subparse_complex_command($tokens,$strategies,\$piped,\$foreground,{})];
543	}
544
545	sub _subparse_complex_command {
546	my ($tokens,$use_strats,$piped,$foreground,$alias_disabled)=@_;
547	my @simplecommands= parse_simple_command($tokens,$use_strats, $piped,$alias_disabled,$foreground);
548
549	while (@$tokens > 0 && $tokens->[0][0] == T_PIPE) {
550	shift @$tokens;
551	$$piped= 1;
552	push @simplecommands, parse_simple_command($tokens,$use_strats,$piped,$alias_disabled,$foreground);
553	}
554
555	if (@$tokens > 0 && $tokens->[0][0] == T_BACKGROUND) {
556	shift @$tokens;
557	$$foreground = 0;
558	}
559	return @simplecommands;
560	}
561
562	sub parse_simple_command {
563	my ($tokens,$use_strats,$piped,$alias_disabled,$foreground)=@_;
564	my (@words,@options,@savetokens,@precom);
565	my $opt={};
566
567	my $firstwords=1;
568	while (@$tokens > 0 and
569	($tokens->[0][0] == T_WORD or
570	$tokens->[0][0] == T_REDIRECT)) {
571	my $token = shift @$tokens;
572	if ($token->[0] == T_WORD) {
573	if ($firstwords and
574	($token->[1] eq 'noglob' or
575	$token->[1] eq 'noexpand' or
576	$token->[1] eq 'noalias')) {
577	push @precom, $token;
578	$opt->{$token->[1]}=1;
579	} else {
580	$firstwords=0;
581	push @savetokens,$token;
582	push @words, $token->[1];
583	}
584	} elsif ($token->[0] == T_REDIRECT) {
585	push @options, $token;
586	} else {
587	}
588	}
589
590	if (%Psh::Support::Alias::aliases and
591	!$opt->{noalias} and
592	$Psh::Support::Alias::aliases{$words[0]} and
593	!$alias_disabled->{$words[0]}) {
594	my $alias= $Psh::Support::Alias::aliases{$words[0]};
595	$alias =~ s/\'/\\\'/g;
596	$alias_disabled->{$words[0]}=1;
597	my @tmp= make_tokens($alias);
598	unshift @tmp, @precom;
599	shift @savetokens;
600	push @tmp, @savetokens;
601	push @tmp, @options;
602	return _subparse_complex_command(\@tmp,$use_strats,$piped,$foreground,$alias_disabled);
603	} elsif (substr($words[0],0,1) eq "\\") {
604	$words[0]=substr($words[0],1);
605	}
606
607	my $line= join ' ', @words;
608	local $Psh::current_options= $opt;
609	foreach my $strat (@$use_strats) {
610	my $how= eval {
611	$strat->applies(\$line,\@words,$$piped);
612	};
613	if ($@) {
614	print STDERR $@;
615	}
616	elsif ($how) {
617	my $name= $strat->name;
618	Psh::Util::print_debug_class('s',
619	"[Using strategy $name: $how]\n");
620	return [ $strat, $how, \@options, \@words, $line, $opt];
621	}
622	}
623	Psh::Util::print_error_i18n('clueless',$line,$Psh::bin);
624	die '';
625	}
626
627	# TODO: right now this is pretty much of a hack. Could it be improved?
628	# For example, 'print hello \n' on the command line gets double
629	# quotes around hello and \n, so that it ends up doing
630	# print("hello","\n") which looks nice but is a surprise to
631	# bash users. Perhaps backslash escapes simply shouldn't be OK?
632
633	sub needs_double_quotes
634	{
635	my ($word) = @_;
636
637	return if !defined($word) or !$word;
638
639	if ($word =~ m/[a-zA-Z]/ # if it has some letters
640	and $word =~ m!^(\\.\|[$.:a-zA-Z0-9/.])*$!) { # and only these characters
641	return 1; # then double-quote it
642	}
643
644	return 0;
645	}
646
647
648
649
650	1;
651	__END__
652
653	=head1 NAME
654
655	Psh::Parser - Perl Shell Parser
656
657	=head1 SYNOPSIS
658
659	use Psh::Parser;
660
661	=head1 DESCRIPTION
662
663	=over 4
664
665	=item *
666
667	array decompose(regexp DELIMITER, string LINE, int PIECES,
668	bool KEEP, hashref QUOTINGPAIRS,
669	scalarref UNMATCHED_QUOTE)
670
671	decompose is a cross between split() and
672	Text::ParseWords::parse_line: it breaks LINE into at most PIECES
673	pieces separated by DELIMITER, except that the hash given by the
674	reference QUOTINGPAIRS specifies pairs of quotes (each key is an
675	open quote which matches the corresponding value) which prevent
676	splitting on internal instances of DELIMITER, and negate the effect
677	of other quotes. The quoting characters are retained if KEEP is
678	true, discarded otherwise. Matches to the regexp METACHARACTERS
679	(outside quotes) are their own words, regardless of being delimited.
680	Backslashes escape the meanings of characters that might match
681	delimiters, quotes, or metacharacters. Initial unquoted empty
682	pieces are suppressed.
683
684	The regexp DELIMITER may contain a single back-reference parenthesis
685	construct, in which case the matches to the parenthesized
686	subexpression are also placed among the pieces, as with the
687	built-in split. METACHARACTERS may not contain any parenthesized
688	subexpression.
689
690	decompose returns the array of pieces. If UNMATCHED_QUOTE is
691	specified, 1 will be placed in the scalar referred to if LINE
692	contained an unmatched quote, 0 otherwise.
693
694	If PIECES is undefined, as many pieces as
695	necessary are used. KEEP defaults to 1. If QUOTINGPAIRS is
696	undefined, {"'" => "'", "\"" => "\""} is used, i.e. single and
697	double quotes are recognized. Supply a reference to an empty hash to
698	have no quoting characters. METACHARACTERS defaults to a regexp that
699	never matches.
700
701	EXAMPLE: if $line is exactly
702
703	echo fred(joe, "Happy Days", ' steve"jan ', "\"Oh, no!\"")
704
705	then decompose(' ', $line) should break it at the
706	following places marked by vertical bars:
707
708	echo\|fred(joe,\|"Happy Days",\|' steve"jan',\|"\"Oh, no!\"")
709
710	=item *
711
712	int incomplete_expr(string LINE)
713
714	Returns 2 if LINE has unmatched quotations. Returns -1 if LINE has
715	mismatched parens. Otherwise, returns 1 if LINE has an unmatched
716	open brace, parenthesis, or square bracket and 0 in all other
717	cases. Summing up, negative is a mismatch, 0 is all OK, and positive
718	is unfinished business. (Reasonably good, can be fooled with some
719	effort. I therefore have deliberately not taken comments into
720	account, which means you can use them to "unfool" this function, but
721	also that unmatched stuff in comments WILL fool this function.)
722
723	=item *
724
725	string unquote( string word)
726
727	Removes quotes from a word and backslash escapes
728
729	=item *
730
731	bool needs_double_quotes (string WORD)
732
733	Returns true if WORD needs double quotes around it to be interpreted
734	in a "shell-like" manner when passed to eval. This covers barewords,
735	expressions that just have \-escapes and $variables in them, and
736	filenames.
737
738	=back
739
740	=head1 AUTHOR
741
742	Various
743
744	=cut