view release on metacpan or  search on metacpan

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

        my $opt = shift @w;
        $mode = 'v' if $opt =~ /v/;
        $mode = 'V' if $opt =~ /V/;
        # -p: accepted, no effect
    }
    # A bare "--" ends option parsing.
    shift @w if @w && $w[0] eq '--';

    if (!@w) { $LAST_STATUS = ($mode ne '') ? 1 : 0; return $LAST_STATUS }

    if ($mode eq 'v' || $mode eq 'V') {
        my $status = 0;
        for my $name (@w) {
            my ($kind, $detail) = _sh_name_kind($name);
            if ($mode eq 'V') {
                _print_type_verbose($name, $kind, $detail) or $status = 1;
            }
            else {   # -v
                if    ($kind eq 'alias') { print "alias $name='" . (defined $detail ? $detail : '') . "'\n" }
                elsif ($kind eq 'file')  { print $detail, "\n" }
                elsif ($kind eq '')      { $status = 1 }
                else                     { print $name, "\n" }   # keyword/function/builtin
            }
        }
        $LAST_STATUS = $status;
        return $status;
    }

    # Plain run form: re-dispatch the raw remainder with function lookup
    # suppressed.  Recover the text after the leading "command" word (and any
    # -p / -- options) from the pre-expansion source so _expand() runs once.
    my $raw = defined $raw_pre ? $raw_pre : $rest;
    $raw =~ s/\A\s*//;
    $raw =~ s/\A[Cc][Oo][Mm][Mm][Aa][Nn][Dd]\b//;
    $raw =~ s/\A\s+//;
    while ($raw =~ /\A(-[pvV]+|--)\s/) {
        my $tok = $1;
        $raw =~ s/\A(?:-[pvV]+|--)\s+//;
        last if $tok eq '--';
    }
    local $_CMD_NO_FUNC = 1;
    return _exec_line($class, $raw, $opts_ref);
}

# ----------------------------------------------------------------
# Background execution helpers (v1)
# ----------------------------------------------------------------
# ----------------------------------------------------------------
# umask / hash / readonly / mapfile  (v0.08)
# ----------------------------------------------------------------
# _sh_is_readonly(NAME): true when NAME carries the readonly attribute.
sub _sh_is_readonly {
    my ($name) = @_;
    return 0 unless defined $name;
    return $_SH_READONLY{ uc($name) } ? 1 : 0;
}

# _sh_store_scalar(NAME, VALUE): the single choke point for a plain scalar
# assignment.  Honours the readonly attribute (refused, status source
# returns 0) and the integer attribute (VALUE evaluated as arithmetic).
# Returns 1 when the value was stored, 0 when a readonly variable blocked
# it.  All the ordinary assignment paths (VAR=val, prefix VAR=val cmd,
# export VAR=val) funnel through here so the attributes are enforced
# uniformly.
sub _sh_store_scalar {
    my ($name, $val) = @_;
    $val = _unprotect_lit($val) if defined $val;
    my $ik = uc($name);
    if ($_SH_READONLY{$ik}) {
        print STDERR "sh: $name: readonly variable\n";
        return 0;
    }
    if ($_SH_INTATTR{$ik}) {
        $val = _eval_arith(defined $val ? $val : '');
    }
    BATsh::Env->set($name, $val);
    return 1;
}

# umask [-S] [MODE]
#   With no MODE, print the current file-creation mask (octal, or symbolic
#   with -S).  A numeric (octal) MODE sets the mask.  Uses Perl's umask, so
#   it is a genuine process mask on Unix-like systems (a no-op reflecting
#   whatever the C library reports on Win32).
sub _cmd_umask {
    my ($rest) = @_;
    $rest = '' unless defined $rest;
    $rest =~ s/\A\s+//; $rest =~ s/\s+\z//;

    # Seed the shell mask from the real process umask on first use.
    if (!$_SH_UMASK_INIT) {
        my $u = umask();
        $_SH_UMASK = defined $u ? $u : 0;
        $_SH_UMASK_INIT = 1;
    }

    my $symbolic = 0;
    if ($rest =~ s/\A-S\b\s*//) { $symbolic = 1 }

    if ($rest eq '') {
        if ($symbolic) { print _umask_symbolic($_SH_UMASK), "\n" }
        else           { printf "%04o\n", $_SH_UMASK }
        $LAST_STATUS = 0;
        return 0;
    }
    if ($rest =~ /\A[0-7]+\z/) {
        $_SH_UMASK = oct($rest) & 0777;
        umask($_SH_UMASK);   # honoured on Unix, harmless where it is not
        $LAST_STATUS = 0;
        return 0;
    }
    # Symbolic mode: "u=rwx,g=rx,o=rx" (and +/- ops).  The operand names the
    # permissions to LEAVE enabled; the mask is their complement.
    my $sym = _umask_apply_symbolic($_SH_UMASK, $rest);
    if (defined $sym) {
        $_SH_UMASK = $sym;
        umask($_SH_UMASK);
        $LAST_STATUS = 0;
        return 0;
    }
    print STDERR "sh: umask: $rest: invalid mask\n";