view release on metacpan or  search on metacpan

lib/App/Cme/Command/run.pm  view on Meta::CPAN

#
# This software is Copyright (c) 2014-2022 by Dominique Dumont <ddumont@cpan.org>.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
# ABSTRACT: Run a cme script

package App::Cme::Command::run ;
$App::Cme::Command::run::VERSION = '1.047';
use strict;
use warnings;
use v5.20;
use File::HomeDir;
use Path::Tiny;
use Config::Model 2.156; # for delete_instance
use Config::Model::Lister;
use Log::Log4perl qw(get_logger :levels);
use YAML::PP;

use Encode qw(decode_utf8);

use App::Cme -command ;

use base qw/App::Cme::Common/;
use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;

my $__test_home = '';
# used only by tests
## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
sub _set_test_home { $__test_home = shift; return;}

my $home = $__test_home || File::HomeDir->my_home;

my @script_paths = map {path($_)} (
    "$home/.cme/scripts",
    "/etc/cme/scripts/",
);

push @script_paths, path($INC{"Config/Model.pm"})->parent->child("Model/scripts") ;

sub opt_spec {
    my ( $class, $app ) = @_;
    return ( 
        [ "arg=s@"  => "script argument. run 'cme run <script> -doc' for possible arguments" ],
        [ "backup:s"  => "Create a backup of configuration files before saving." ],
        [ "foreach=s" => "Run script in several directories. The list of directories "
          . "must be passed as a single argument, i.e. --foreach 'foo bar'. If this "
          . "argument is '-', the list is taken from STDIN."],
        [ "commit|c:s" => "commit change with passed message" ],
        [ "cat" => "Show the script file" ],
        [ "no-commit|nc!" => "skip commit to git" ],
        [ "doc!"    => "show documention of script" ],
        [ "list!"   => "list available scripts" ],
        $class->cme_global_options,
    );
}

sub validate_args {
    my ($self, $opt, $args) = @_;

    $self->check_unknown_args($args);
    return;
}

sub usage_desc {
  my ($self) = @_;
  my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o"
  return "$desc [ script ] [ -args foo=12 [ -args bar=13 ]";
}

sub description {
    my ($self) = @_;
    return $self->get_documentation;
}

sub check_script_arguments ($self, $opt, $script_name) {
    if ($opt->{list} or not $script_name) {
        my @scripts;
        foreach my $path ( @script_paths ) {
            next unless $path->is_dir;
            push @scripts, map {$_->basename} grep { ! /~$/ } $path->children();
        }
        say $opt->{list} ? "Available scripts:" : "Missing script argument. Choose one of:";
        foreach my $script_path (sort @scripts) {
            my $data = $self->get_script_data($script_path);
            printf("- %s (app: %s)\n",$script_path, $data->{app} );
        }
        say "";
        say "Run 'cme run <script> -doc' to get more details on a script.";
        return 0;
    }
    return 1;
}

sub find_script_file ($self, $script_name) {
    my $script;
    if ($script_name =~ m!/!) {
        $script = path($script_name);
    }
    else {
        # check script in known locations
        foreach my $path ( @script_paths ) {
            next unless $path->is_dir;
            $script = $path->child($script_name);
            last if $script->is_file;
        }
    }

    die "Error: cannot find script $script_name\n" unless $script->is_file;

    return $script;
}

## no critic (Subroutines::ProhibitManyArgs)
sub replace_var_in_value ($user_args, $script_var, $data, $value) {
    state $var_pattern = qr~(?<!\\) \$([a-zA-Z]\w+) (?!\s*{)~x;

    # change $var but not \$var, not $var{} and not $1