view release on metacpan or  search on metacpan

lib/App/NDTools/NDQuery.pm  view on Meta::CPAN

sub arg_opts {
    my $self = shift;

    return (
        $self->SUPER::arg_opts(),
        'colors!' => \$self->{OPTS}->{colors},
        'delete|ignore=s@' => \$self->{OPTS}->{delete},
        'depth|d=i' => \$self->{OPTS}->{depth},
        'grep=s@' => \$self->{OPTS}->{grep},
        'keys' => \$self->{OPTS}->{keys},
        'list|l' => \$self->{OPTS}->{list},
        'md5' => \$self->{OPTS}->{md5},
        'path|p=s' => \$self->{OPTS}->{path},
        'raw-output' => sub { $self->{OPTS}->{ofmt} = 'RAW' },
        'replace' => \$self->{OPTS}->{replace},
        'strict!' => \$self->{OPTS}->{strict},
        'values|vals' => \$self->{OPTS}->{values},
    );
}

sub check_args {
    my $self = shift;

    if ($self->{OPTS}->{replace}) {
        die_fatal "--replace opt can't be used with --keys", 1
            if ($self->{OPTS}->{keys});
        die_fatal "--replace opt can't be used with --list", 1
            if ($self->{OPTS}->{list});
        die_fatal "--replace opt can't be used with --md5", 1
            if ($self->{OPTS}->{md5});
    }

    return $self;
}

sub configure {
    my $self = shift;

    $self->SUPER::configure();

    $self->{OPTS}->{colors} = $self->{TTY}
        unless (defined $self->{OPTS}->{colors});

    for (
        @{$self->{OPTS}->{grep}},
        @{$self->{OPTS}->{delete}}
    ) {
        my $tmp = eval { str2path($_) };
        die_fatal "Failed to parse '$_'", 4 if ($@);
        $_ = $tmp;
    }

    return $self;
}

sub defaults {
    my $self = shift;

    return {
        %{$self->SUPER::defaults()},
        'color-common' => 'bold black',
        'strict' => 1, # exit with 8 if unexisted path specified
        'ofmt' => 'JSON',
    };
}

sub dump {
    my ($self, $uri, $data) = @_;

    $uri = \*STDOUT unless ($self->{OPTS}->{replace});
    s_dump($uri, $self->{OPTS}->{ofmt}, {pretty => $self->{OPTS}->{pretty}}, @{$data});
}

sub exec {
    my $self = shift;

    for my $uri (@{$self->{ARGV}} ? @{$self->{ARGV}} : \*STDIN) {
        my @data = $self->load_struct($uri, $self->{OPTS}->{ifmt});

        if (defined $self->{OPTS}->{path}) {
            my $spath = eval { str2path($self->{OPTS}->{path}) };
            die_fatal "Failed to parse '$self->{OPTS}->{path}'", 4 if ($@);

            unless (@data = path($data[0], $spath, deref => 1)) {
                die_fatal "Failed to lookup path '$self->{OPTS}->{path}'", 8
                    if ($self->{OPTS}->{strict});
                next;
            }
        }

        @data = $self->grep($self->{OPTS}->{grep}, @data)
            if (@{$self->{OPTS}->{grep}});

        for my $spath (@{$self->{OPTS}->{delete}}) {
            map { path($_, $spath, delete => 1) if (ref $_) } @data;
        }

        if ($self->{OPTS}->{keys}) {
            $self->list_keys(\@data);
        } elsif ($self->{OPTS}->{list}) {
            $self->list($uri, \@data);
        } elsif ($self->{OPTS}->{md5}) {
            $self->md5($uri, \@data);
        } else {
            $self->dump($uri, \@data);
        }
    }

    die_info "All done", 0;
}

my $JSON = JSON->new->canonical->allow_nonref;

sub list_keys {
    my ($self, $data) = @_;
    my @out;

    for (@{$data}) {
        if (ref $_ eq 'HASH') {
            push @out, sort keys %{$_};
        } elsif (ref $_ eq 'ARRAY') {