view release on metacpan or  search on metacpan

lib/App/short.pm  view on Meta::CPAN

    v => 1.1,
    args => {
        %common_args,
        short => {
            schema => 'str*',
            req => 1,
            pos => 0,
            completion => $_completion_short,
        },
    },
};
sub get_short_target {
    unless (PRELOAD) { require Cwd; } #PRELOAD
    unless (PRELOAD) { require File::Spec; } #PRELOAD
    my %args = @_;
    my $res = _validate(\%args);
    return [200,"Invalid input: $res->[0] - $res->[1]"]
        unless $res->[0] == 200;

    my $S = $args{short_dir};
    #my $L = $args{long_dir};

    my $dir = readlink("$S/$args{short}");
    return [200, "Short name not found"] unless $dir;
    $dir = Cwd::abs_path(
        File::Spec->rel2abs(
            $dir, Cwd::abs_path($S),
        ));
    return [200, "Can't abs_path"] unless $dir;
    [200, "OK", $dir];
}

$SPEC{add_short} = {
    v => 1.1,
    args => {
        %common_args,
        long => {
            schema => 'str*',
            req => 1,
            pos => 0,
            completion => $_completion_missing,
        },
        short => {
            schema => 'str*',
            req => 1,
            pos => 1,
        },
    },
};
sub add_short {
    use experimental 'smartmatch';
    unless (PRELOAD) { require Cwd; } #PRELOAD
    unless (PRELOAD) { require File::Spec; } #PRELOAD
    my %args = @_;
    my $res = _validate(\%args);
    return $res unless $res->[0] == 200;

    my $S = $args{short_dir};
    my $L = $args{long_dir};

    return [404, "No such long name '$args{long}'"]
        unless (-d "$L/$args{long}");
    return [412, "Short name '$args{short}' already exists"]
        if (-l "$S/$args{short}");

    symlink(File::Spec->abs2rel(
        Cwd::abs_path("$L/$args{long}"),
        Cwd::abs_path($S),
    ), "$S/$args{short}") or return [500, "Can't create symlink: $!"];

    [200, "OK"];
}

$SPEC{rm_short} = {
    v => 1.1,
    args => {
        %common_args,
        short => {
            schema => ['array*', of=>'str*', min_len=>1],
            req => 1,
            pos => 0,
            greedy => 1,
            element_completion => $_completion_short,
        },
    },
};
sub rm_short {
    unless (PRELOAD) { require Perinci::Object; } #PRELOAD
    my %args = @_;
    my $res = _validate(\%args);
    return $res unless $res->[0] == 200;

    my $S = $args{short_dir};

    my $envres = Perinci::Object::envresmulti();

    for my $s (@{ $args{short} }) {
        my $path = "$S/$s";

        if (!(-l $path)) {
            $envres->add_result(404, "Short name not found", {item_id=>$s});
        } elsif (!unlink($path)) {
            $envres->add_result(500, "Can't unlink: $!", {item_id=>$s});
        } else {
            $envres->add_result(200, "OK", {item_id=>$s});
        }
    }

    $envres->as_struct;
}

1;
# ABSTRACT: Manage short directory symlinks

__END__

=pod

=encoding UTF-8

=head1 NAME

App::short - Manage short directory symlinks

=head1 VERSION

This document describes version 0.14 of App::short (from Perl distribution App-short), released on 2017-07-10.

=head1 SYNOPSIS

Please see L<short> script.

=head1 FUNCTIONS


=head2 add_short

Usage:

 add_short(%args) -> [status, msg, result, meta]

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<long>* => I<str>

=item * B<long_dir>* => I<str>

=item * B<long_include> => I<array[str]>

=item * B<short>* => I<str>

=item * B<short_dir>* => I<str>

=back

Returns an enveloped result (an array).