view release on metacpan or  search on metacpan

lib/App/riap/Commands.pm  view on Meta::CPAN

    "x.app.riap.aliases" => ["list"],
};
sub ls {
    my %args = @_;
    my $shell = $args{-shell};

    my $pwd = $shell->state("pwd");
    my $uri;
    my ($dir, $leaf);
    my $resmeta = {};

    my @allres;
    #for my $path (@{ $args{paths} // [undef] }) {
    for my $path ($args{path}) {
        $uri = $pwd . ($pwd =~ m!/\z! ? "" : "/");
        if (defined $path) {
            $uri = _concat_and_normalize_path_with_slash($pwd, $path);
        }

        my $res;
        if ($args{long}) {
            $res = $shell->riap_request(child_metas => $uri);
            return $res unless $res->[0] == 200;
            for my $u (sort keys %{ $res->[2] }) {
                my $m = $res->[2]{$u};
                next if defined($leaf) && length($leaf) && $u ne $leaf;
                my $type; # XXX duplicate code somewhere
                if ($u =~ m!/\z!) {
                    $type = 'package';
                } elsif ($u =~ /\A\$/) {
                    $type = 'variable';
                } elsif ($u =~ /\A\w+\z/) {
                    $type = 'function';
                }
                push @allres, {
                    uri         => $u,
                    type        => $type,
                    summary     => $m->{summary},
                    date        => $m->{entity_date},
                    v           => $m->{entity_v},
                };
            }
            my $ff = [qw/type uri v date summary/];
            my $rfo = {

            };
            $resmeta = {
                "table.fields"   => $ff,
            };
        } else {
            $res = $shell->riap_request(list => $uri);
            return $res unless $res->[0] == 200;

            for (@{ $res->[2] }) {
                next if defined($leaf) && length($leaf) && $_ ne $leaf;
                push @allres, $_;
            }
        }

        if (!@allres && defined($leaf) && length($leaf)) {
            return [404, "No such file (Riap entity): $path"];
        }

    }
    [200, "OK", \@allres, $resmeta];
}

$SPEC{pwd} = {
    v => 1.1,
    summary => 'shows current directory',
    args => {
    },
};
sub pwd {
    my %args = @_;
    my $shell = $args{-shell};

    [200, "OK", $shell->{_state}{pwd}];
}

$SPEC{cd} = {
    v => 1.1,
    summary => "changes directory",
    args => {
        dir => {
            summary    => '',
            schema     => ['str*'],
            pos        => 0,
            completion => $complete_dir,
        },
    },
};
sub cd {
    my %args = @_;
    my $dir = $args{dir};
    my $shell = $args{-shell};

    my $opwd = $shell->state("pwd");
    my $npwd;
    if (!defined($dir)) {
        # back to start pwd
        $npwd = $shell->state("start_pwd");
    } elsif ($dir eq '-') {
        if (defined $shell->state("old_pwd")) {
            $npwd = $shell->state("old_pwd");
        } else {
            warn "No old pwd set\n";
            return [200, "Nothing done"];
        }
    } else {
        if (is_abs_path($dir)) {
            $npwd = normalize_path($dir);
        } else {
            $npwd = concat_and_normalize_path($opwd, $dir);
        }
    }
    # check if path actually exists
    my $uri = $npwd . ($npwd =~ m!/\z! ? "" : "/");
    my $res = $shell->riap_request(info => $uri);
    if ($res->[0] == 404) {
        return [404, "No such directory (Riap package)"];
    } elsif ($res->[0] != 200) {
        return $res;
    }
    #return [403, "Not a directory (package)"]
    #    unless $res->[2]{type} eq 'package';

    log_trace("Setting npwd=%s, opwd=%s", $npwd, $opwd);
    $shell->state(pwd     => $npwd);
    $shell->state(old_pwd => $opwd);
    [200, "OK"];
}

$SPEC{set} = {
    v => 1.1,
    summary => "lists or sets setting",
    args => {
        name => {
            summary    => '',
            schema     => ['str*'],
            pos        => 0,
            # we use custom completion because the list of known settings must
            # be retrieved through the shell object
            completion => $complete_setting_name,
        },
        value => {
            summary    => '',
            schema     => ['any'],
            pos        => 1,
            completion => sub {
                require Perinci::Sub::Complete;

                my %args = @_;
                my $shell = $args{-shell};
                my $args  = $args{args};
                return [] unless $args->{name};
                my $setting = $shell->known_settings->{ $args->{name} };
                return [] unless $setting;

                # a hack, construct a throwaway meta and using that to complete
                # setting argument as function argument
                Perinci::Sub::Complete::complete_arg_val(
                    arg=>'foo',
                    meta=>{v=>1.1, args=>{foo=>{schema=>$setting->{schema}}}},
                );
            },
        },
    },
};
sub set {
    my %args = @_;
    my $shell = $args{-shell};

    my $name  = $args{name};

    if (exists $args{value}) {
        # set setting
        return [400, "Unknown setting, use 'set' to list all known settings"]
            unless exists $shell->known_settings->{$name};
        $shell->setting($name, $args{value});
        [200, "OK"];