view release on metacpan or  search on metacpan

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

use List::Util 1.33 qw/all/;

binmode STDOUT, ':encoding(UTF-8)';

my %meta_cmd = (
    check => \&check,
    dump => \&dump_cds,
    'dump-yaml' => \&dump_yaml,
    'gen-dot' => \&gen_dot,
    edit => \&edit,
    save => \&save,
    plugin => \&plugin,
);

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

    my $mc = $opt->{'_meta_command'} = shift @$args  || die "please specify meta sub command\n";

    if (not $meta_cmd{$mc}) {
        die "Unexpected meta sub command: '$mc'. Expected ".join(' ', sort keys %meta_cmd)."\n";
    }

    my ( $categories, $appli_info, $appli_map ) = Config::Model::Lister::available_models;
    my $application = shift @$args;

    if ($mc eq 'plugin') {
        unless ($application) {
            die "Missing application name after 'plugin' command";
        }
        $opt->{_root_model} = $appli_map->{$application}
            || die "Unknown application $application";
    }
    elsif ($application) {
        $opt->{_root_model} = $appli_map->{$application} || $application;
    }

    Config::Model::Exception::Any->Trace(1) if $opt->{trace};

    $opt->{_application} = $application ;

    return;
}

sub validate_factorize ($flag) {
    return 1 if $flag eq 'all';
    return all {/^description|summary|warp|status|level$/;} split /,/,$flag;
}

sub opt_spec {
    my ( $class, $app ) = @_;

    return (
		[
            "dir=s"         => "directory where to read and write a model",
            {default => 'lib/Config/Model'}
        ],
        [
            "dumptype=s" => "dump every values (full), only preset values "
            . "or only customized values (default)",
            {callbacks => { 'expected values' => sub { $_[0] =~ m/^full|preset|custom$/ ; }}}
        ],
        [ "dev!"          => 'use model in ./lib to create a plugin'],
        [
            "factorize=s"   => 'factorize class parameters. Comma separated list of either '.
            '"description", "summary", "level", "warp", "status, or just "all"',
             {callbacks => { 'expected "all" or a list' => sub { validate_factorize($_[0]); }}},
        ],
		[ "open-item=s"   => "force the UI to open the specified node"],
		[ "plugin-file=s" => "create a model plugin in this file" ],
        [ "load-yaml=s"   => "load model from YAML file. Use '-' to load from STDIN" ],
        [ "load=s"        => "load model from cds file (Config::Model serialisation file). "
          ."Use '-' to load from STDIN"],
        [ "system!"       => "read model from system files" ],
        [ "test-and-quit=s" => "Used for tests" ],
        $class->cme_global_options()
    );
}

sub usage_desc {
  my ($self) = @_;
  my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o"
  return "$desc [ ".join(' | ', sort keys %meta_cmd)." ] your_model_class ";
}

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

sub read_data {
    my $load_file = shift ;

    my @data ;
    if ( $load_file eq '-' ) {
        ## no critic (InputOutput::ProhibitExplicitStdin)
        # user called cme with -load - or -load-yaml -, cannot use ARGV
        @data = <STDIN> ;
    }
    else {
        open my $load, '<', $load_file || die "cannot open load file $load_file:$!";
        @data = <$load> ;
        close $load;
    }

    return wantarray ? @data : join('',@data);
}

sub load_optional_data {
    my ($self, $args, $opt, $root_model, $meta_root) = @_;

    if (defined $opt->{load}) {
        my $data = read_data($opt->{load}) ;
        $data = qq(class:"$root_model" ).$data unless $data =~ /^\s*class:/ ;
        $meta_root->load($data);
    }

    if (defined $opt->{'load-yaml'}) {
        my $yaml = read_data($opt->{'load-yaml'}) ;
        my $pdata = Load($yaml) ;
        $meta_root->load_data($pdata) ;
    }
    return;
}

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