view release on metacpan or  search on metacpan

lib/BATsh/SH.pm  view on Meta::CPAN

    # substitution below: POSIX expands ~word from the literal source
    # text only, once, at the start of a word (or right after the '='
    # of a leading NAME= assignment).  A ~ that only appears because a
    # $VAR happened to hold a string starting with "~" must NOT be
    # re-expanded -- doing tilde expansion after $VAR substitution
    # cannot tell the two cases apart, so it must happen first here.
    $str = _tilde_prepass($str);

    # Protect backslash escapes before any expansion.  In POSIX shells the
    # backslash inside double quotes keeps its special meaning only before
    # $ ` " \ and newline, so "\$" is a literal dollar (NO expansion), "\`"
    # is a literal backtick (NO command substitution) and "\\" is a literal
    # backslash.  Earlier releases performed the $-/`-substitutions globally
    # with no escape awareness, so "\$_" expanded $_ to empty and left the
    # stray backslash (giving e.g. perl -e "...uc(\)..." -> syntax error).
    # We stash the escaped specials under NUL-delimited sentinels (a NUL can
    # never occur in shell source) and restore them as literals at the end.
    # Order matters: "\\" first so that "\\$" means backslash + expansion.
    $str =~ s/\\\\/\x00BATSH_BS\x00/g;   # \\  -> literal backslash
    $str =~ s/\\\$/\x00BATSH_DL\x00/g;   # \$  -> literal dollar (no expand)
    $str =~ s/\\`/\x00BATSH_BT\x00/g;    # \`  -> literal backtick (no subst)

    # $(( arithmetic ))
    $str =~ s/\$\(\(\s*(.*?)\s*\)\)/_eval_arith($1)/ge;

    # <(cmd) / >(cmd) process substitution (v0.07) -- MUST run before
    # $(...) below, and before backtick substitution, so that <(...) is
    # never mistaken for a stray "<" redirection operator by the later
    # redirect-stripping stage.
    $str = _replace_process_subst($class, $str);

    # $( command ) substitution
    # Use _extract_cmd_subst to correctly handle nested () and quoted ) chars.
    $str = _replace_cmd_subst($class, $str);

    # backtick command substitution: `cmd`
    $str =~ s/`([^`]*)`/_protect_lit(_cmd_subst($class, $1))/ge;

    # ---- Array expansions (v0.06) ----------------------------------
    # These MUST precede the scalar ${#VAR} / ${VAR} rules below so that a
    # subscripted reference is never mis-parsed as a plain variable.

    # ${#NAME[@]} / ${#NAME[*]} -- number of set elements
    $str =~ s/\$\{#([A-Za-z_][A-Za-z0-9_]*)\[[\@*]\]\}/
        _arr_count($1)
    /ge;

    # ${#NAME[SUB]} -- length of one element
    $str =~ s/\$\{#([A-Za-z_][A-Za-z0-9_]*)\[([^\]]*)\]\}/
        do {
            my $v = _arr_get_element($1, _arr_expand_sub($class, $2));
            defined $v ? length($v) : 0
        }
    /ge;

    # ${!NAME[@]} / ${!NAME[*]} -- list of indices / keys
    $str =~ s/\$\{!([A-Za-z_][A-Za-z0-9_]*)\[[\@*]\]\}/
        _protect_lit(join(' ', _arr_ordered_keys($1)))
    /ge;

    # ${NAME[@]} / ${NAME[*]} -- all elements (space-joined word-split model)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\[[\@*]\]\}/
        _protect_lit(join(' ', _arr_values($1)))
    /ge;

    # ${NAME[SUB]} -- single element
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\[([^\]]*)\]\}/
        do {
            my $v = _arr_get_element($1, _arr_expand_sub($class, $2));
            defined $v ? _protect_lit($v) : ''
        }
    /ge;
    # ----------------------------------------------------------------

    # ${#VAR} -- length of value (characters, not bytes, under DBCS guard)
    $str =~ s/\$\{#([A-Za-z_][A-Za-z0-9_]*)\}/
        do { my $v = BATsh::Env->get($1);
             defined $v ? BATsh::MB::mb_length($v) : 0 }
    /ge;

    # ${VAR%%pattern} -- remove longest suffix   (MUST be before single %)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)%%([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_remove_suffix($v, $2, 1)) }
    /ge;

    # ${VAR%pattern}  -- remove shortest suffix  (single %, not %%)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)%(?!%)([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_remove_suffix($v, $2, 0)) }
    /ge;

    # ${VAR##pattern} -- remove longest prefix   (MUST be before single #)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)##([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_remove_prefix($v, $2, 1)) }
    /ge;

    # ${VAR#pattern}  -- remove shortest prefix  (single #, not ##)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)#(?!#)([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_remove_prefix($v, $2, 0)) }
    /ge;

    # ${VAR//pat/rep} -- replace all occurrences  (MUST be before single /)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\/\/([^\/}]*)\/([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_replace($v, $2, $3, 1)) }
    /ge;

    # ${VAR/pat/rep} -- replace first occurrence  (single /, not //)
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\/(?!\/)([^\/}]*)\/([^}]*)\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(_sh_replace($v, $2, $3, 0)) }
    /ge;

    # ${VAR^^} -- uppercase all
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\^\^\}/
        do { my $v = BATsh::Env->get($1); defined $v ? _protect_lit(uc($v)) : '' }
    /ge;

    # ${VAR^} -- uppercase first char
    $str =~ s/\$\{([A-Za-z_][A-Za-z0-9_]*)\^\}/
        do { my $v = BATsh::Env->get($1); $v = defined $v ? $v : ''; _protect_lit(ucfirst($v)) }
    /ge;

    # ${VAR,,} -- lowercase all