BATsh
view release on metacpan or search on metacpan
lib/BATsh/SH.pm view on Meta::CPAN
my $n = scalar @c;
my $i = 0;
while ($i < $n) {
my $ch = $c[$i];
if ($_OPT_EXTGLOB && $ch =~ /[?*+\@!]/ && $i+1 < $n && $c[$i+1] eq '(') {
my @eg = _extglob_scan(\@c, $i, \&_case_glob_to_re);
if (@eg) { $re .= $eg[1]; $i = $eg[0]; next }
}
if ($ch eq "'") { # literal single-quoted run
$i++;
while ($i < $n && $c[$i] ne "'") { $re .= quotemeta($c[$i]); $i++ }
$i++; next;
}
if ($ch eq '"') { # literal double-quoted run
$i++;
while ($i < $n && $c[$i] ne '"') {
if ($c[$i] eq '\\' && $i + 1 < $n) {
$i++; $re .= quotemeta($c[$i]); $i++; next;
}
$re .= quotemeta($c[$i]); $i++;
}
$i++; next;
}
if ($ch eq '\\') { # escaped literal
$i++; $re .= quotemeta($c[$i]) if $i < $n; $i++; next;
}
if ($ch eq '*') { $re .= '.*'; $i++; next }
if ($ch eq '?') { $re .= '.'; $i++; next }
if ($ch eq '[') { # character class
my $j = $i + 1;
my $neg = 0;
if ($j < $n && ($c[$j] eq '!' || $c[$j] eq '^')) { $neg = 1; $j++ }
my $body = '';
if ($j < $n && $c[$j] eq ']') { $body .= '\\]'; $j++ } # leading ] literal
while ($j < $n && $c[$j] ne ']') {
my $cc = $c[$j];
if ($cc eq '\\' && $j + 1 < $n) {
$body .= '\\' . $c[$j + 1]; $j += 2; next;
}
if ($cc eq '\\' || $cc eq '^' || $cc eq ']') { $body .= '\\' . $cc }
else { $body .= $cc }
$j++;
}
if ($j < $n && $c[$j] eq ']') {
$re .= '[' . ($neg ? '^' : '') . $body . ']';
$i = $j + 1; next;
}
$re .= '\\['; $i++; next; # unterminated [ : literal
}
$re .= quotemeta($ch);
$i++;
}
return $re;
}
# ----------------------------------------------------------------
# extglob (v0.07): ?(list) *(list) +(list) @(list) !(list) pattern-list
# operators, active only while "shopt -s extglob" is on. Shared by
# _case_glob_to_re() (case patterns) and _glob_to_re() (${VAR%pat} and
# friends). $convert_sub converts one pattern-list alternative (which
# may itself contain nested extglob groups) to a regex fragment.
#
# Returns ($pos_after_close_paren, $regex_fragment), or () when the
# text at $i is not a well-formed extglob group (extglob is then left
# to fall through to its ordinary, literal meaning for that character).
#
# !(list) is approximated as "any run of characters that never forms a
# complete match of one of the alternatives" via a negative lookahead
# repeated per character; this matches the common "exclude these whole
# patterns" usage (e.g. !(*.jpg|*.png)) but, unlike real extglob, is not
# exact when !(...) is combined with more pattern after it in the same
# glob -- documented as a known limitation.
# ----------------------------------------------------------------
sub _extglob_scan {
my ($chars_ref, $i, $convert_sub) = @_;
my @c = @{$chars_ref};
my $n = scalar @c;
return () unless $i+1 < $n && $c[$i+1] eq '(';
my $op = $c[$i];
my $depth = 1;
my $j = $i + 2;
my $body = '';
while ($j < $n && $depth > 0) {
my $cc = $c[$j];
if ($cc eq '(') { $depth++; $body .= $cc; $j++ }
elsif ($cc eq ')') { $depth--; $j++; $body .= $cc if $depth > 0 }
elsif ($cc eq '\\' && $j+1 < $n) { $body .= $cc . $c[$j+1]; $j += 2 }
else { $body .= $cc; $j++ }
}
return () if $depth != 0;
my @alts = _extglob_split_alts($body);
my @re_alts = map { $convert_sub->($_) } @alts;
my $inner = '(?:' . join('|', @re_alts) . ')';
my $frag;
if ($op eq '?') { $frag = $inner . '?' }
elsif ($op eq '*') { $frag = $inner . '*' }
elsif ($op eq '+') { $frag = $inner . '+' }
elsif ($op eq '@') { $frag = $inner }
elsif ($op eq '!') { $frag = '(?:(?!' . $inner . ').)*' }
else { return () }
return ($j, $frag);
}
# _extglob_split_alts: split an extglob pattern-list body on top-level
# '|' (respecting nested parens and backslash escapes).
sub _extglob_split_alts {
my ($body) = @_;
my @out;
my $cur = '';
my @c = split //, $body;
my $n = scalar @c;
my $i = 0;
my $depth = 0;
while ($i < $n) {
my $ch = $c[$i];
if ($ch eq '\\' && $i+1 < $n) { $cur .= $ch . $c[$i+1]; $i += 2; next }
if ($ch eq '(') { $depth++; $cur .= $ch; $i++; next }
if ($ch eq ')') { $depth--; $cur .= $ch; $i++; next }
if ($ch eq '|' && $depth == 0) { push @out, $cur; $cur = ''; $i++; next }
$cur .= $ch; $i++;
}
push @out, $cur;
return @out;
}
# ----------------------------------------------------------------
# External command
# ----------------------------------------------------------------
# ----------------------------------------------------------------
# _split_sh_pipe: split a SH command line on bare | characters,
# respecting single-quoted, double-quoted, and $(...) regions.
# Returns a list of segment strings; length 1 means no pipe found.
# ----------------------------------------------------------------
# _split_sh_compound: split a SH line on bare && / || / ;
# Returns list of { op => '', cmd => '...' } hashrefs.
# Length 1 means no compound operator found.
# Respects single-quotes, double-quotes, and $(...) nesting.
# ----------------------------------------------------------------
# _sh_strip_redirects: parse SH-style redirections from a command line.
#
# Recognized forms (processed right-to-left, last one wins per fd):
# cmd > file stdout overwrite
# cmd >> file stdout append
# cmd < file stdin
# cmd 2> file stderr overwrite
# cmd 2>> file stderr append
# cmd 2>&1 stderr to stdout (recorded as fd=2, file='&1')
# cmd 1>&2 stdout to stderr (recorded as fd=1, file='&2')
#
# Returns ($clean_cmd, \@redirs) where each redir is [fd, append, file].
# Parsing respects single-quotes, double-quotes, and backslash escapes.
# ----------------------------------------------------------------
# ----------------------------------------------------------------
# _sh_strip_herestring: detect an unquoted "<<< word" (here-string) on
# an already variable-expanded line. Returns ($line_without_it,
# $dequoted_word) when found, or ($line, undef) otherwise. Only the
# first occurrence on the line is honoured (one here-string per
# command, matching the existing single-here-document limitation).
# ----------------------------------------------------------------
sub _sh_strip_herestring {
my ($line) = @_;
lib/BATsh/SH.pm view on Meta::CPAN
}
if (!$in_dq && !$in_bt && $pdep == 0 && $bdep == 0 && $ch eq ';') {
push @segs, $cur; $cur = ''; $i++;
# collapse a following ';' (e.g. ";;") into the same split so
# empty segments are not produced for the common cases
next;
}
$cur .= $ch; $i++;
}
push @segs, $cur;
return @segs;
}
# _inline_has_terminator: does the SINGLE physical line hold, as a
# top-level ';'-delimited segment, a bare terminator word ($term, e.g.
# 'fi' / 'done' / 'esac')? Used to detect a fully-inline control
# structure written on one physical line.
sub _inline_has_terminator {
my ($line, $term) = @_;
return 0 unless defined $line;
for my $seg (_split_top_semi($line)) {
my $s = $seg;
$s =~ s/\A\s+//; $s =~ s/\s+\z//;
return 1 if lc($s) eq lc($term);
}
return 0;
}
# _inline_expand: turn a fully-inline control-structure physical line
# into the list of "logical lines" the multi-line block parsers expect.
# It splits on top-level ';' and then peels a leading 'then'/'do'/'else'
# keyword off its segment onto its own logical line (so "then echo a"
# becomes "then" + "echo a"), which is exactly the shape _parse_if /
# _parse_for / _parse_while consume line-by-line.
sub _inline_expand {
my ($line) = @_;
my @out;
for my $seg (_split_top_semi($line)) {
my $s = $seg;
$s =~ s/\A\s+//; $s =~ s/\s+\z//;
next if $s eq '';
if ($s =~ /\A(then|do|else)\b\s*(.*)\z/is) {
my ($kw, $tail) = (lc($1), $2);
push @out, $kw;
push @out, $tail if defined $tail && $tail =~ /\S/;
}
else {
push @out, $s;
}
}
return @out;
}
# _strip_sh_comment: remove a trailing "# ..." comment from one SH
# physical line. A '#' introduces a comment only when it is unquoted,
# outside any $(...)/${...}/`...` region, and begins a word (preceded by
# the start of line or by whitespace / ; / & / | / '(' ). This leaves
# parameter forms such as $#, ${#var}, ${var#pat} and an in-word '#'
# (echo a#b, http://h#frag) untouched, matching POSIX shells. Pure Perl
# 5.005_03 (hand-rolled scan; no regex features).
sub _strip_sh_comment {
my ($line) = @_;
return $line unless defined $line && index($line, '#') >= 0;
my @c = split //, $line;
my $n = scalar @c;
my $in_sq = 0;
my $in_dq = 0;
my $in_bt = 0;
my $pdep = 0;
my $bdep = 0;
my $prev = ''; # previous scanned char (for word-boundary test)
my $i = 0;
while ($i < $n) {
my $ch = $c[$i];
if ($in_sq) { $in_sq = 0 if $ch eq "'"; $prev = $ch; $i++; next }
if ($ch eq "'" && !$in_dq && !$in_bt) { $in_sq = 1; $prev = $ch; $i++; next }
if ($ch eq '"' && !$in_bt) { $in_dq = !$in_dq; $prev = $ch; $i++; next }
if ($ch eq '\\') { $prev = 'x'; $i += 2; next }
if ($ch eq '`') { $in_bt = !$in_bt; $prev = $ch; $i++; next }
if (!$in_dq && !$in_bt) {
if ($ch eq '$' && $i+1 < $n && $c[$i+1] eq '{') { $bdep++; $prev = '{'; $i += 2; next }
if ($bdep > 0 && $ch eq '}') { $bdep--; $prev = $ch; $i++; next }
if ($ch eq '(') { $pdep++; $prev = $ch; $i++; next }
if ($ch eq ')' && $pdep > 0) { $pdep--; $prev = $ch; $i++; next }
}
if ($ch eq '#' && !$in_sq && !$in_dq && !$in_bt && $pdep == 0 && $bdep == 0) {
if ($prev eq '' || $prev =~ /\s/
|| $prev eq ';' || $prev eq '&' || $prev eq '|' || $prev eq '(') {
my $out = ($i > 0) ? join('', @c[0 .. $i-1]) : '';
$out =~ s/\s+\z//;
return $out;
}
}
$prev = $ch; $i++;
}
return $line;
}
# _if_depth_delta: net change in if/fi nesting contributed by one
# physical line, counting only command-position 'if' openers (+1) and
# 'fi' closers (-1). A fully-inline "if ...; then ...; fi" nets to 0.
# Used by _parse_if's body collector so a nested if is not closed by the
# outer 'fi'. Other block types (for/while/case) use different
# terminators (done/esac) and so never affect the if/fi balance.
sub _if_depth_delta {
my ($line) = @_;
my $d = 0;
for my $seg (_split_top_semi($line)) {
my $s = $seg;
$s =~ s/\A\s+//;
$s =~ s/\A(?:then|do|else)\b\s*//i; # peel a leading block keyword
my ($w) = ($s =~ /\A(\S+)/);
$w = defined($w) ? lc($w) : '';
$d++ if $w eq 'if';
$d-- if $w eq 'fi';
}
return $d;
}
lib/BATsh/SH.pm view on Meta::CPAN
}
if ($i < $n && $chars[$i] eq ']') { $cls .= '\\]'; $i++ }
while ($i < $n && $chars[$i] ne ']') {
$cls .= ($chars[$i] eq '\\') ? '\\\\' : $chars[$i];
$i++;
}
$cls .= ']';
$re .= $cls;
}
else { $re .= quotemeta($c) }
$i++;
}
return $re;
}
sub _sh_remove_suffix {
my ($val, $pat, $greedy) = @_;
# % (greedy=0, shortest suffix): keep longest prefix
# => /\A(.*) PATTERN \z/s with greedy prefix => $1
# %% (greedy=1, longest suffix): keep shortest prefix
# => /\A(.*?)PATTERN \z/s with lazy prefix => $1
my $re = _glob_to_re($pat, 1); # pattern itself is always greedy for suffix
if ($greedy) {
# longest suffix removed: lazy prefix
return ($val =~ /\A(.*?)$re\z/s) ? $1 : $val;
}
else {
# shortest suffix removed: greedy prefix
return ($val =~ /\A(.*)$re\z/s) ? $1 : $val;
}
}
sub _sh_remove_prefix {
my ($val, $pat, $greedy) = @_;
# # (greedy=0, shortest prefix): keep longest suffix
# => /\A PATTERN(.*) \z/s with lazy pattern => $1
# ## (greedy=1, longest prefix): keep shortest suffix
# => /\A PATTERN(.*) \z/s with greedy pattern => $1
my $re = _glob_to_re($pat, $greedy);
return ($val =~ /\A$re(.*)\z/s) ? $1 : $val;
}
sub _sh_replace {
my ($val, $pat, $rep, $global) = @_;
my $re = _glob_to_re($pat, 1);
if ($global) { $val =~ s/$re/$rep/g }
else { $val =~ s/$re/$rep/ }
return $val;
}
# ----------------------------------------------------------------
# Shell function registry { name => \@body_lines }
# ----------------------------------------------------------------
# ----------------------------------------------------------------
# _inline_body_has_control: true when a single-line function body
# (the text between the braces of "name() { ... }") contains a shell
# control-structure keyword in command position -- if/for/while/until/
# case/select as the first word, or after a ';', '&&', '||' or '|'.
# Such a body must not be torn apart on ';' (that would split
# "while C; do B; done" into unusable fragments); the caller keeps it
# as one line so _run_lines()'s inline-control handling parses it.
# Quotes, $(...), `...` and ${...} are skipped so a keyword appearing
# only inside them (echo "done", VAR=$(case ...)) does not count.
# Perl 5.005_03 compatible: character scan, no regex features beyond
# \A and \b.
# ----------------------------------------------------------------
sub _inline_body_has_control {
my ($body) = @_;
return 0 unless defined $body && $body =~ /\S/;
my @c = split //, $body;
my $n = scalar @c;
my $in_sq = 0; my $in_dq = 0; my $in_bt = 0;
my $pdep = 0; my $bdep = 0;
my $i = 0;
my $cmd_pos = 1;
while ($i < $n) {
my $ch = $c[$i];
if ($in_sq) { $in_sq = 0 if $ch eq "'"; $i++; next }
if ($ch eq "'" && !$in_dq && !$in_bt) { $in_sq = 1; $cmd_pos = 0; $i++; next }
if ($ch eq '"' && !$in_bt) { $in_dq = !$in_dq; $cmd_pos = 0; $i++; next }
if ($ch eq '\\') { $i += 2; $cmd_pos = 0; next }
if ($ch eq '`') { $in_bt = !$in_bt; $cmd_pos = 0; $i++; next }
if (!$in_dq && !$in_bt) {
if ($ch eq '$' && $i+1 < $n && $c[$i+1] eq '{') { $bdep++; $i += 2; $cmd_pos = 0; next }
if ($bdep > 0 && $ch eq '}') { $bdep--; $i++; next }
if ($ch eq '$' && $i+1 < $n && $c[$i+1] eq '(') { $pdep++; $i += 2; $cmd_pos = 0; next }
if ($ch eq '(') { $pdep++; $i++; $cmd_pos = 1; next }
if ($ch eq ')' && $pdep > 0) { $pdep--; $i++; next }
}
if (!$in_dq && !$in_bt && $pdep == 0 && $bdep == 0) {
if ($ch eq ';') { $cmd_pos = 1; $i++; next }
if ($ch eq '&' && $i+1 < $n && $c[$i+1] eq '&') { $cmd_pos = 1; $i += 2; next }
if ($ch eq '|' && $i+1 < $n && $c[$i+1] eq '|') { $cmd_pos = 1; $i += 2; next }
if ($ch eq '|') { $cmd_pos = 1; $i++; next }
if ($ch eq '&') { $cmd_pos = 1; $i++; next }
if ($ch =~ /\s/) { $i++; next }
if ($cmd_pos) {
my $tail = join('', @c[$i .. $n-1]);
if ($tail =~ /\A(?:if|for|while|until|case|select)\b/i) {
return 1;
}
}
$cmd_pos = 0; $i++; next;
}
$i++;
}
return 0;
}
# ----------------------------------------------------------------
# _parse_function: parse "name() {" or "function name {" blocks
# Returns ($status, $new_i).
# ----------------------------------------------------------------
sub _parse_function {
my ($class, $lines_ref, $start, $opts_ref) = @_;
my @lines = @{$lines_ref};
my $line = $lines[$start];
$line =~ s/\r?\n\z//;
$line =~ s/\A\s+//;
lib/BATsh/SH.pm view on Meta::CPAN
=head2 Brace Expansion
echo a{b,c,d}e # abe ace ade
echo {1..5} # 1 2 3 4 5
echo {5..1} # 5 4 3 2 1
echo {01..03} # 01 02 03 (zero-padded from the wider operand)
echo {a..e} # a b c d e
echo {1..10..2} # 1 3 5 7 9 (numeric step)
echo {a..e..2} # a c e (alpha step)
echo pre{a,b}mid{c,d}post # preamidcpost preamidcpost ...
Brace expansion (v0.07) runs lexically on the raw source line, before any
other expansion, exactly like tilde expansion. A brace group is only
expanded when it contains a top-level comma or a valid C<..> range;
otherwise it -- and any earlier literal braces on the same word -- is
left untouched (C<echo x{foo}y> prints C<x{foo}y>). Quoted text and
C<${...}>, C<$(...)>, C<$((...))>, C<`...`>, C<E<lt>(...)>, C<E<gt>(...)>
regions are protected and copied through unexpanded, matching the fact
that these are not brace-expansion syntax even though some of them also
use C<{> C<}> or C<(> C<)>. Nested and nested nested groups are
supported (each alternative is itself recursively brace-expanded).
=head2 Extended Pattern Matching (extglob)
shopt -s extglob # enable; "shopt -u extglob" disables (the default)
shopt extglob # query; "shopt" alone lists all known options
shopt -p extglob # print in "shopt -s/-u extglob" form
case $f in
@(*.tar.gz|*.tgz)) echo archive ;;
!(*.jpg|*.png)) echo not-an-image ;;
esac
echo ${name%%+([0-9])} # strip a trailing run of digits
While C<shopt -s extglob> is active, C<?(list)>, C<*(list)>, C<+(list)>,
C<@(list)>, and C<!(list)> pattern-list operators (C<|>-separated
alternatives, each itself an ordinary glob or a nested extglob group) are
recognised in case patterns and in the C<${VAR%pat}> / C<${VAR%%pat}> /
C<${VAR#pat}> / C<${VAR##pat}> / C<${VAR/pat/rep}> / C<${VAR//pat/rep}>
pattern operand. C<extglob> is off by default, matching bash, and is
reset to off by C<reset_sh_options()> between top-level runs, alongside
C<set -e> / C<-u> / C<-x>.
=head3 Extended Pattern Matching Limitations
=over 4
=item *
Extglob operators are recognised in case patterns and in the
C<${VAR#pat}>-family parameter-expansion patterns only. Pathname
(filename) globbing (C<echo *.@(jpg|png)>) does not expand them: an
unquoted C<(> C<)> is read by the line parser as a subshell command
group long before the word reaches the pathname matcher.
=item *
C<!(list)> is approximated with a repeated negative-lookahead regex
fragment ("any run of characters that never forms a complete match of
one of the alternatives"). This matches the common "exclude these whole
patterns" usage exactly, but is not a byte-for-byte reimplementation of
bash's extglob matcher when C<!(...)> is combined with further pattern
text after it in the same glob.
=back
=head2 Here-Strings
cat <<< "$greeting"
read LINE <<< hello
A here-string (C<E<lt>E<lt>E<lt> word>, v0.07) supplies I<word> -- after
tilde, parameter, command, and arithmetic expansion, and quote removal,
exactly like any other word -- as the command's standard input, with a
trailing newline appended. Unlike a here-document body, I<word> is not
further word-split. Implementation-wise this reuses the here-document
temporary-file machinery: the expanded content is written to a uniquely
named C<sysopen(...,O_CREAT|O_EXCL,...)> temp file and supplied through
the same redirection path as C<E<lt> file>, removed immediately after the
command finishes. As with here-documents, only one here-string (or
here-document) per command line is handled.
=head2 Process Substitution
diff <(sort a.txt) <(sort b.txt)
generate | tee >(gzip > out.gz)
This interpreter never forks (see L</Background Execution> above), so
neither form of process substitution (v0.07) uses a real named pipe:
=over 4
=item C<E<lt>(cmd)>
I<cmd> is run immediately, its standard output captured into a fresh
temporary file (exactly like C<$(cmd)>, but the file is kept rather than
read back into a scalar), and C<E<lt>(cmd)> is replaced by that file's
path -- suitable for anything that wants a filename to read from.
=item C<E<gt>(cmd)>
An empty temporary file is created immediately and C<E<gt>(cmd)> is
replaced by its path; I<cmd> itself is deferred and run with that file as
its standard input only after the current simple command has finished.
Because I<cmd> runs after, rather than concurrently with, the writer,
this is a best-effort approximation of real streaming C<E<gt>(...)> and
does not suit a writer that expects the reader to keep up in real time.
=back
Both temporary files are removed once the current simple command (and,
for C<E<gt>(cmd)>, its deferred job) has finished; a process substitution
used inside a nested command substitution or loop condition is cleaned
up at that inner level, not held open for the rest of the script.
=head2 select
select CHOICE in one two three
do
( run in 1.754 second using v1.01-cache-2.11-cpan-b16cb0d3907 )