App-ZodiacUtils
view release on metacpan or search on metacpan
script/_zodiac-of view on Meta::CPAN
# my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
# _is_simple_or_array_of_simple_or_hash_of_simple($sch);
#
# # XXX normalization of 'of' clause should've been handled by sah itself
# if ($type eq 'array' && $cset->{of}) {
# $cset->{of} = normalize_schema($cset->{of});
# }
# my $opt = _arg2opt($fqarg);
# if ($seen_opts->{$opt}) {
# my $i = 1;
# my $opt2;
# while (1) {
# $opt2 = "$opt-arg" . ($i > 1 ? $i : '');
# last unless $seen_opts->{$opt2};
# $i++;
# }
# $opt = $opt2;
# }
#
# my $stash = {};
#
# # why we use coderefs here? due to Getopt::Long's behavior. when
# # @ARGV=qw() and go_spec is ('foo=s' => \$opts{foo}) then %opts will
# # become (foo=>undef). but if go_spec is ('foo=s' => sub { $opts{foo} =
# # $_[1] }) then %opts will become (), which is what we prefer, so we can
# # later differentiate "unspecified" (exists($opts{foo}) == false) and
# # "specified as undef" (exists($opts{foo}) == true but
# # defined($opts{foo}) == false).
#
# my $handler = sub {
# my ($val, $val_set);
#
# # how many times have been called for this argument?
# my $num_called = ++$stash->{called}{$arg};
#
# # hashify rargs till the end of the handler scope if it happens to
# # be an array (this is the case when we want to fill values using
# # element_meta).
# my $rargs = do {
# if (ref($rargs) eq 'ARRAY') {
# $rargs->[$num_called-1] //= {};
# $rargs->[$num_called-1];
# } else {
# $rargs;
# }
# };
#
# if ($is_simple) {
# $val_set = 1; $val = $_[1];
# $rargs->{$arg} = $val;
# } elsif ($is_array_of_simple) {
# $rargs->{$arg} //= [];
# $val_set = 1; $val = $_[1];
# push @{ $rargs->{$arg} }, $val;
# } elsif ($is_hash_of_simple) {
# $rargs->{$arg} //= {};
# $val_set = 1; $val = $_[2];
# $rargs->{$arg}{$_[1]} = $val;
# } else {
# {
# my ($success, $e, $decoded);
# ($success, $e, $decoded) = _parse_json($_[1]);
# if ($success) {
# $val_set = 1; $val = $decoded;
# $rargs->{$arg} = $val;
# last;
# }
# ($success, $e, $decoded) = _parse_yaml($_[1]);
# if ($success) {
# $val_set = 1; $val = $decoded;
# $rargs->{$arg} = $val;
# last;
# }
# die "Invalid YAML/JSON in arg '$fqarg'";
# }
# }
# if ($val_set && $arg_spec->{cmdline_on_getopt}) {
# $arg_spec->{cmdline_on_getopt}->(
# arg=>$arg, fqarg=>$fqarg, value=>$val, args=>$rargs,
# opt=>$opt,
# );
# }
# }; # handler
#
# my @triplets = _opt2ospec($opt, $sch, $arg_spec);
# my $aliases_processed;
# while (my ($ospec, $parsed, $extra) = splice @triplets, 0, 3) {
# $extra //= {};
# if ($extra->{is_neg}) {
# $go_spec->{$ospec} = sub { $handler->($_[0], 0) };
# } elsif (defined $extra->{is_neg}) {
# $go_spec->{$ospec} = sub { $handler->($_[0], 1) };
# } elsif ($extra->{is_base64}) {
# $go_spec->{$ospec} = sub {
# require MIME::Base64;
# my $decoded = MIME::Base64::decode($_[1]);
# $handler->($_[0], $decoded);
# };
# } else {
# $go_spec->{$ospec} = $handler;
# }
#
# $specmeta->{$ospec} = {arg=>$arg, fqarg=>$fqarg, parsed=>$parsed, %$extra};
# for (@{ $parsed->{opts} }) {
# $seen_opts->{$_}++; $seen_func_opts->{$_} = $fqarg;
# }
#
# if ($parent_args->{per_arg_json} && !$is_simple) {
# my $jopt = "$opt-json";
# if ($seen_opts->{$jopt}) {
# warn "Clash of option: $jopt, not added";
# } else {
# my $jospec = "$jopt=s";
# my $parsed = {type=>"s", opts=>[$jopt]};
# $go_spec->{$jospec} = sub {
# my ($success, $e, $decoded);
# ($success, $e, $decoded) = _parse_json($_[1]);
# if ($success) {
# $rargs->{$arg} = $decoded;
# } else {
# die "Invalid JSON in option --$jopt: $_[1]: $e";
# }
# };
# $specmeta->{$jospec} = {arg=>$arg, fqarg=>$fqarg, is_json=>1, parsed=>$parsed, %$extra};
# $seen_opts->{$jopt}++; $seen_func_opts->{$jopt} = $fqarg;
# }
# }
# if ($parent_args->{per_arg_yaml} && !$is_simple) {
# my $yopt = "$opt-yaml";
# if ($seen_opts->{$yopt}) {
# warn "Clash of option: $yopt, not added";
# } else {
# my $yospec = "$yopt=s";
# my $parsed = {type=>"s", opts=>[$yopt]};
# $go_spec->{$yospec} = sub {
# my ($success, $e, $decoded);
# ($success, $e, $decoded) = _parse_yaml($_[1]);
# if ($success) {
# $rargs->{$arg} = $decoded;
# } else {
# die "Invalid YAML in option --$yopt: $_[1]: $e";
# }
# };
# $specmeta->{$yospec} = {arg=>$arg, fqarg=>$fqarg, is_yaml=>1, parsed=>$parsed, %$extra};
# $seen_opts->{$yopt}++; $seen_func_opts->{$yopt} = $fqarg;
# }
# }
#
# # parse argv_aliases
# if ($arg_spec->{cmdline_aliases} && !$aliases_processed++) {
# for my $al (keys %{$arg_spec->{cmdline_aliases}}) {
# my $alspec = $arg_spec->{cmdline_aliases}{$al};
# my $alsch = $alspec->{schema} //
# $alspec->{is_flag} ? [bool=>{req=>1,is=>1}] : $sch;
# my $altype = $alsch->[0];
# my $alopt = _arg2opt("$argprefix$al");
# if ($seen_opts->{$alopt}) {
# warn "Clash of cmdline_alias option $al";
# next;
# }
# my $alcode = $alspec->{code};
# my $alospec;
# my $parsed;
# if ($alcode && $alsch->[0] eq 'bool') {
# # bool --alias doesn't get --noalias if has code
# $alospec = $alopt; # instead of "$alopt!"
# $parsed = {opts=>[$alopt]};
# } else {
# ($alospec, $parsed) = _opt2ospec($alopt, $alsch);
# }
#
# if ($alcode) {
# if ($alcode eq 'CODE') {
# if ($parent_args->{ignore_converted_code}) {
# $alcode = sub {};
# } else {
# return [
# 501,
# join("",
# "Code in cmdline_aliases for arg $fqarg ",
# "got converted into string, probably ",
# "because of JSON/YAML transport"),
# ];
# }
# }
# # alias handler
# $go_spec->{$alospec} = sub {
#
# # do the same like in arg handler
# my $num_called = ++$stash->{called}{$arg};
# my $rargs = do {
# if (ref($rargs) eq 'ARRAY') {
# $rargs->[$num_called-1] //= {};
# $rargs->[$num_called-1];
# } else {
# $rargs;
# }
# };
#
script/_zodiac-of view on Meta::CPAN
# # 1. first we generate Getopt::Long spec
# my $genres = $fargs{ggls_res} // gen_getopt_long_spec_from_meta(
# meta => $meta, meta_is_normalized => 1,
# args => $rargs,
# common_opts => $common_opts,
# per_arg_json => $per_arg_json,
# per_arg_yaml => $per_arg_yaml,
# ignore_converted_code => $ignore_converted_code,
# );
# return err($genres->[0], "Can't generate Getopt::Long spec", $genres)
# if $genres->[0] != 200;
# my $go_spec = $genres->[2];
#
# # 2. then we run GetOptions to fill $rargs from command-line opts
# #$log->tracef("GetOptions spec: %s", \@go_spec);
# {
# local $SIG{__WARN__} = sub{} if !$strict;
# my $old_go_conf = Getopt::Long::Configure(
# $strict ? "no_pass_through" : "pass_through",
# "no_ignore_case", "permute", "no_getopt_compat", "gnu_compat", "bundling");
# my $res = Getopt::Long::GetOptionsFromArray($argv, %$go_spec);
# Getopt::Long::Configure($old_go_conf);
# unless ($res) {
# return [500, "GetOptions failed"] if $strict;
# }
# }
#
# # 3. then we try to fill $rargs from remaining command-line arguments (for
# # args which have 'pos' spec specified)
#
# my $args_prop = $meta->{args};
#
# if (@$argv) {
# my $res = get_args_from_array(
# array=>$argv, meta => $meta,
# meta_is_normalized => 1,
# allow_extra_elems => $allow_extra_elems,
# );
# if ($res->[0] != 200 && $strict) {
# return err(500, "Get args from array failed", $res);
# } elsif ($strict && $res->[0] != 200) {
# return err("Can't get args from argv", $res);
# } elsif ($res->[0] == 200) {
# my $pos_args = $res->[2];
# for my $name (keys %$pos_args) {
# my $arg_spec = $args_prop->{$name};
# my $val = $pos_args->{$name};
# if (exists $rargs->{$name}) {
# return [400, "You specified option --$name but also ".
# "argument #".$arg_spec->{pos}] if $strict;
# }
# my ($is_simple, $is_array_of_simple, $is_hash_of_simple, $type, $cset, $eltype) =
# _is_simple_or_array_of_simple_or_hash_of_simple($arg_spec->{schema});
#
# if (($arg_spec->{slurpy} // $arg_spec->{greedy}) && ref($val) eq 'ARRAY' &&
# !$is_array_of_simple && !$is_hash_of_simple) {
# my $i = 0;
# for (@$val) {
# TRY_PARSING_AS_JSON_YAML:
# {
# my ($success, $e, $decoded);
# if ($per_arg_json) {
# ($success, $e, $decoded) = _parse_json($_);
# if ($success) {
# $_ = $decoded;
# last TRY_PARSING_AS_JSON_YAML;
# } else {
# warn "Failed trying to parse argv #$i as JSON: $e";
# }
# }
# if ($per_arg_yaml) {
# ($success, $e, $decoded) = _parse_yaml($_);
# if ($success) {
# $_ = $decoded;
# last TRY_PARSING_AS_JSON_YAML;
# } else {
# warn "Failed trying to parse argv #$i as YAML: $e";
# }
# }
# }
# $i++;
# }
# }
# if (!($arg_spec->{slurpy} // $arg_spec->{greedy}) && !$is_simple) {
# TRY_PARSING_AS_JSON_YAML:
# {
# my ($success, $e, $decoded);
# if ($per_arg_json) {
# ($success, $e, $decoded) = _parse_json($val);
# if ($success) {
# $val = $decoded;
# last TRY_PARSING_AS_JSON_YAML;
# } else {
# warn "Failed trying to parse argv #$arg_spec->{pos} as JSON: $e";
# }
# }
# if ($per_arg_yaml) {
# ($success, $e, $decoded) = _parse_yaml($val);
# if ($success) {
# $val = $decoded;
# last TRY_PARSING_AS_JSON_YAML;
# } else {
# warn "Failed trying to parse argv #$arg_spec->{pos} as YAML: $e";
# }
# }
# }
# }
# $rargs->{$name} = $val;
# # we still call cmdline_on_getopt for this
# if ($arg_spec->{cmdline_on_getopt}) {
# if ($arg_spec->{slurpy} // $arg_spec->{greedy}) {
# $arg_spec->{cmdline_on_getopt}->(
# arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
# opt=>undef, # this marks that value is retrieved from cmdline arg
# ) for @$val;
# } else {
# $arg_spec->{cmdline_on_getopt}->(
# arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
# opt=>undef, # this marks that value is retrieved from cmdline arg
# );
# }
# }
# }
# }
# }
#
# # 4. check missing required args
#
# my %missing_args;
# for my $arg (keys %$args_prop) {
# my $arg_spec = $args_prop->{$arg};
# if (!exists($rargs->{$arg})) {
# next unless $arg_spec->{req};
# # give a chance to hook to set missing arg
# if ($on_missing) {
# next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
# }
# next if exists $rargs->{$arg};
# $missing_args{$arg} = 1;
# }
# }
#
# # 5. check 'deps', currently we only support 'arg' dep type
# {
# last unless $strict;
#
# for my $arg (keys %$args_prop) {
# my $arg_spec = $args_prop->{$arg};
# next unless exists $rargs->{$arg};
# next unless $arg_spec->{deps};
# my $dep_arg = $arg_spec->{deps}{arg};
# next unless $dep_arg;
# return [400, "You specify '$arg', but don't specify '$dep_arg' ".
# "(upon which '$arg' depends)"]
# unless exists $rargs->{$dep_arg};
# }
# }
#
# #$log->tracef("<- get_args_from_argv(), args=%s, remaining argv=%s",
# # $rargs, $argv);
( run in 0.518 second using v1.01-cache-2.11-cpan-39bf76dae61 )