view release on metacpan or  search on metacpan

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

sub dump_opts {
    my $self = shift;

    delete $self->{OPTS}->{'dump-opts'};
    s_dump(\*STDOUT, undef, undef, $self->{OPTS});
}

sub grep {
    my ($self, $spaths, @structs) = @_;
    my @out;

    for my $struct (@structs) {
        my (%map_idx, $path, $ref, $grepped);

        for (@{$spaths}) {
            my @found = eval { path($struct, $_, deref => 1, paths => 1) };

            while (($path, $ref) = splice @found, 0, 2) {
                # remap array's indexes
                my $map_key = "";
                my $map_path = [];

                for my $step (@{$path}) {
                    if (ref $step eq 'ARRAY') {
                        $map_key .= "[]";
                        unless (exists $map_idx{$map_key}->{$step->[0]}) {
                            $map_idx{$map_key}->{$step->[0]} =
                                keys %{$map_idx{$map_key}};
                        }

                        push @{$map_path}, [$map_idx{$map_key}->{$step->[0]}];
                    } else { # HASH
                        $map_key .= "{$step->{K}->[0]}";
                        push @{$map_path}, $step;
                    }
                }

                path($grepped, $map_path, assign => $ref, expand => 1);
            }
        }

        push @out, $grepped if (defined $grepped);
    }

    return @out;
}

sub load_struct {
    my ($self, $uri, $fmt) = @_;

    log_trace { ref $uri ? "Reading from STDIN" : "Loading '$uri'" };
    s_load($uri, $fmt);
}

sub new {
    my $self = bless {}, shift;

    $self->{OPTS} = $self->defaults();
    $self->{ARGV} =
        [ map { decode(locale => "$_", Encode::FB_CROAK) } @_ ? @_ : @ARGV ];

    $self->{TTY} = -t STDOUT;

    unless (GetOptionsFromArray ($self->{ARGV}, $self->arg_opts)) {
        $self->usage;
        die_fatal "Unsupported opts used", 1;
    }

    if ($self->{OPTS}->{help}) {
        $self->usage;
        die_info, 0;
    }

    if ($self->{OPTS}->{version}) {
        print $self->VERSION . "\n";
        die_info, 0;
    }

    $self->configure();

    if ($self->{OPTS}->{'dump-opts'}) {
        $self->dump_opts();
        die_info, 0;
    }

    return $self;
}

sub usage {
    require Pod::Usage;
    Pod::Usage::pod2usage(
        -exitval => 'NOEXIT',
        -output => \*STDERR,
        -sections => 'SYNOPSIS|OPTIONS|EXAMPLES',
        -verbose => 99
    );
}

1; # End of App::NDTools::NDTool