view release on metacpan or  search on metacpan

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

    my $self   = \%param;

    bless $self, $class;

    # Find the available commands
    $self->{cmds} = { map {lc $_ => $_} $self->get_modules('App::TemplateCMD::Command') };

    # read the configuration files
    $self->config();

    return $self;
}

sub get_modules {
    my ($self, $base) = @_;
    $base =~ s{::}{/}gxms;

    my %modules;

    for my $dir (grep {-d $_} map { "$_/$base/" } @INC) {
        find(
            sub {
                my ($name) = $File::Find::name =~ m{^ $dir ( [\w/]+ ) .pm $}xms;
                return if !$name;

                $modules{$name}++;
            },
            $dir
        );
    }

    return keys %modules;
}

sub process {

    my ($self, @argv) = @_;

    my $cmd = shift @argv;

    if ( !$cmd || !grep { $_ eq $cmd } keys %{$self->{'cmds'}} ) {
        if ($cmd) {
            $self->unknown_cmd($cmd);
        }

        unshift @argv, $cmd;
        $cmd = 'help';
    }

    my $module  = $self->load_cmd($cmd);
    my %default = $module->default($self);
    my @args    = (
        'out|o=s',
        'args|a=s%',
        'verbose|v!',
        'path|p=s',
        $module->args($self),
    );

    {
        local @ARGV = @argv;
        Getopt::Long::Configure('bundling');
        GetOptions( \%default, @args ) or $module = 'App::TemplateCMD::Command::Help';
        $default{files} = [ @ARGV ];
    }

    my $conf = $self->add_args(\%default);
    my $out;

    my $path = $conf->{path};
    if ( $default{path} ) {
        $path = "$default{path}:$path";
    }
    $path =~ s(~/)($ENV{HOME}/)gxms;

    $self->{providers} = [
        Template::Provider->new({ INCLUDE_PATH => $path }),
    ];

    $self->{template} = Template->new({
        LOAD_TEMPLATES => $self->{providers},
        EVAL_PERL      => 1,
    });

    if ( $default{'out'} ) {
        open $out, '>', $default{out} or die "Could not open the output file '$default{out}': $OS_ERROR\n";
    }
    else {
        $out = *STDOUT;
    }

    print {$out} $module->process($self, %default);

    return;
}

sub add_args {
    my ($self, $default) = @_;
    my @files;

    my $args  = $default->{args}  || {};
    my $files = $default->{files} || [];

    # add any args not prefixed by -a[rgs]
    for my $file (@{$files}) {
        if ($file =~ /=/ ) {

            # merge the argument on to the args hash
            my ($arg, $value) = split /=/, $file, 2;
            $default->{args}->{$arg} = eval { decode_json($value) } || $value;
        }
        else {

            # store the "real" file
            push @files, $file;
        }
    }

    for my $value (values %{$args}) {
        $value = $value =~ /^( q[wqr]?(\W) ) .* ( \2 )$/xms? [ eval($value)  ]    ## no critic
               : $value =~ /^(    \{       ) .* ( \} )$/xms?   eval($value)       ## no critic