view release on metacpan or  search on metacpan

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

sub configure {
    my $self = shift;

    $self->index_modules();

    $self->{rules} = [];
    map { push @{$self->{rules}}, @{$self->load_struct($_)} }
        @{$self->{OPTS}->{rules}}
            if ($self->{OPTS}->{rules});

    if ($self->{OPTS}->{module} or @{$self->{rules}}) {
        log_info { "Explicit rules used: builtin will be ignored" };
        $self->{OPTS}->{'builtin-rules'} = undef;
    }

    $self->{OPTS}->{'disable-module'} =
        { map { $_ => 1 } @{$self->{OPTS}->{'disable-module'}} };
}

sub defaults {
    return {
        'blame' => 1, # may be redefined per-rule
        'builtin-format' => 'RAW',
        'modpath' => [ 'App::NDTools::NDProc::Module' ],
    };
}

sub dump_blame {
    my ($self, $blame) = @_;

    log_debug { "Dumping blame to $self->{OPTS}->{'dump-blame'}" };
    s_dump($self->{OPTS}->{'dump-blame'}, $self->{OPTS}->{ofmt},
        $self->{OPTS}->{pretty}, $blame);
}

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

    log_debug { "Dumping result to $uri" };
    s_dump($uri, $self->{OPTS}->{ofmt}, $self->{OPTS}->{pretty}, $data);
}

sub dump_rules {
    my $self = shift;

    for my $rule (@{$self->{rules}}) {
        # remove undefs - defaults will be used anyway
        map { defined $rule->{$_} || delete $rule->{$_} } keys %{$rule};
    }
    log_debug { "Dumping rules to $self->{OPTS}->{'dump-rules'}" };
    s_dump($self->{OPTS}->{'dump-rules'}, $self->{OPTS}->{ofmt},
        $self->{OPTS}->{pretty}, $self->{rules});
}

sub embed {
    my ($self, $data, $path, $thing) = @_;

    my $spath = eval { str2path($path) };
    die_fatal "Unable to parse '$path' ($@)", 4 if ($@);
    my $ref = eval { (path($data, $spath, expand => 1))[0]};
    die_fatal "Unable to lookup '$path' ($@)", 4 if ($@);

    ${$ref} = $self->{OPTS}->{'builtin-format'} eq 'RAW'
        ? $thing
        : s_encode($thing, $self->{OPTS}->{'builtin-format'}, {pretty => 0});
}

sub exec {
    my $self = shift;

    if ($self->{OPTS}->{'list-modules'}) {
        map { printf "%-16s %-8s %s\n", @{$_} } $self->list_modules;
        die_info undef, 0;
    }

    my $mod;
    if (defined $self->{OPTS}->{module}) {
        die_fatal "Unknown module specified '$self->{OPTS}->{module}'", 1
            unless (exists $self->{MODS}->{$self->{OPTS}->{module}});
        $self->init_module($self->{OPTS}->{module});

        $mod = $self->{MODS}->{$self->{OPTS}->{module}}->new();
        for my $rule ($mod->parse_args($self->{ARGV})->get_opts()) {
            $rule->{modname} = $self->{OPTS}->{module},
            push @{$self->{rules}}, $rule;
        }
    }

    # parse the rest of args (unrecognized by module (if was specified by args))
    # to be sure there is no unsupported opts remain
    my @rest_opts = (
        'help|h' => sub {
            $self->{OPTS}->{help} = 1;
            die "!FINISH";
        },
        'version|V' => sub {
            $self->{OPTS}->{version} = 1;
            die "!FINISH";
        },
    );

    Getopt::Long::Configure('nopass_through');
    unless (GetOptionsFromArray($self->{ARGV}, @rest_opts)) {
        defined $mod ? $mod->usage : $self->usage;
        die_fatal "Unsupported opts passed", 1;
    }

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

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

    if ($self->{OPTS}->{'dump-rules'} and not @{$self->{ARGV}}) {
        $self->dump_rules();
    } else {