App-genpw-base64
view release on metacpan or search on metacpan
script/_genpw-base64 view on Meta::CPAN
# my $rargs = $args{rargs};
# my $go_spec = $args{go_spec};
# my $specmeta = $args{specmeta};
#
# my $args_prop = $meta->{args} // {};
#
# for my $arg (keys %$args_prop) {
# my $fqarg = "$argprefix$arg";
# my $arg_spec = $args_prop->{$arg};
# next if grep { $_ eq 'hidden' || $_ eq 'hidden-cli' }
# @{ $arg_spec->{tags} // [] };
# my $sch = $arg_spec->{schema} // ['any', {}];
# 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);
#
# 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 = {};
#
#
# my $handler = sub {
# my ($val, $val_set);
#
# my $num_called = ++$stash->{called}{$arg};
#
# 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,
# );
# }
# };
#
# 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;
# }
# }
#
# 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') {
# $alospec = $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"),
# ];
# }
# }
# $go_spec->{$alospec} = sub {
#
# my $num_called = ++$stash->{called}{$arg};
# my $rargs = do {
# if (ref($rargs) eq 'ARRAY') {
# $rargs->[$num_called-1] //= {};
# $rargs->[$num_called-1];
# } else {
# $rargs;
# }
# };
#
# $alcode->($rargs, $_[1]);
# };
# } else {
# $go_spec->{$alospec} = $handler;
script/_genpw-base64 view on Meta::CPAN
# my $on_missing = $fargs{on_missing_required_args};
# my $ignore_converted_code = $fargs{ignore_converted_code};
#
# my $rargs = $fargs{args} // {};
#
# 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];
#
# {
# 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;
# }
# }
#
#
# 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->{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->{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;
# if ($arg_spec->{cmdline_on_getopt}) {
# if ($arg_spec->{greedy}) {
# $arg_spec->{cmdline_on_getopt}->(
# arg=>$name, fqarg=>$name, value=>$_, args=>$rargs,
# opt=>undef,
# ) for @$val;
# } else {
# $arg_spec->{cmdline_on_getopt}->(
# arg=>$name, fqarg=>$name, value=>$val, args=>$rargs,
# opt=>undef,
# );
# }
# }
# }
# }
# }
#
#
# my %missing_args;
# for my $arg (keys %$args_prop) {
# my $arg_spec = $args_prop->{$arg};
# if (!exists($rargs->{$arg})) {
# next unless $arg_spec->{req};
# if ($on_missing) {
# next if $on_missing->(arg=>$arg, args=>$rargs, spec=>$arg_spec);
# }
# next if exists $rargs->{$arg};
# $missing_args{$arg} = 1;
# }
# }
#
# {
# 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};
# }
# }
#
# [200, "OK", $rargs, {
# "func.missing_args" => [sort keys %missing_args],
# "func.gen_getopt_long_spec_result" => $genres,
# }];
#}
#
( run in 0.516 second using v1.01-cache-2.11-cpan-140bd7fdf52 )