File-RsyBak
view release on metacpan or search on metacpan
script/rsybak view on Meta::CPAN
# summary => 'Generate help message for Perinci::CmdLine-based app',
# args => {
# program_name => {
# schema => 'str*',
# req => 1,
# },
# program_summary => {
# schema => 'str*',
# },
# subcommands => {
# schema => 'hash',
# },
# meta => {
# summary => 'Function metadata, must be normalized',
# schema => 'hash*',
# req => 1,
# },
# common_opts => {
# schema => 'hash*',
# default => {},
# },
# per_arg_json => {
# schema => 'bool*',
# },
# per_arg_yaml => {
# schema => 'bool*',
# },
# ggls_res => {
# summary => 'Full result from gen_getopt_long_spec_from_meta()',
# schema => 'array*',
# description => <<'_',
#
#If you already call <pm:Perinci::Sub::GetArgs::Argv>'s
#`gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice.
#
#_
# },
# },
#};
#sub gen_help {
# no warnings 'once';
# require Text::Wrap;
#
# my %args = @_;
#
# local $Text::Wrap::columns = $ENV{COLUMNS} // 80;
#
# my $meta = $args{meta};
# my $common_opts = $args{common_opts} // {};
#
# my @help;
#
# my $progname = $args{program_name};
# {
# my $sum = $args{program_summary} // $meta->{summary};
# last unless $sum;
# push @help, $progname, " - ", $sum, "\n\n";
# }
#
# my $clidocdata;
#
# push @help, "Usage:\n";
# {
# for (sort {
# ($common_opts->{$a}{order} // 99) <=>
# ($common_opts->{$b}{order} // 99) ||
# $a cmp $b
# } keys %$common_opts) {
# my $co = $common_opts->{$_};
# next unless $co->{usage};
# push @help, " $progname $co->{usage}\n";
# }
#
# require Perinci::Sub::To::CLIDocData;
# my $res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
# meta => $meta, meta_is_normalized => 1,
# common_opts => $common_opts,
# per_arg_json => $args{per_arg_json},
# per_arg_yaml => $args{per_arg_yaml},
# (ggls_res => $args{ggls_res}) x defined($args{ggls_res}),
# );
# die [500, "gen_cli_doc_data_from_meta failed: ".
# "$res->[0] - $res->[1]"] unless $res->[0] == 200;
# $clidocdata = $res->[2];
# my $usage = $clidocdata->{usage_line};
# $usage =~ s/\[\[prog\]\]/$progname/;
# push @help, " $usage\n";
# }
#
# {
# my $subcommands = $args{subcommands} or last;
# push @help, "\nSubcommands:\n";
# if (keys(%$subcommands) >= 12) {
# push @help, Text::Wrap::wrap(
# " ", " ", join(", ", sort keys %$subcommands)), "\n";
# } else {
# for my $sc_name (sort keys %$subcommands) {
# my $sc_spec = $subcommands->{$sc_name};
# next unless $sc_spec->{show_in_help} //1;
# push @help, " $sc_name\n";
# }
# }
# }
#
# {
# last unless @{ $clidocdata->{examples} };
# push @help, "\nExamples:\n";
# my $i = 0;
# my $egs = $clidocdata->{examples};
# for my $eg (@$egs) {
# $i++;
# my $cmdline = $eg->{cmdline};
# $cmdline =~ s/\[\[prog\]\]/$progname/;
# push @help, "\n" if $eg->{summary} && $i > 1;
# if ($eg->{summary}) {
# push @help, " $eg->{summary}:\n";
# } else {
# push @help, "\n";
# }
# push @help, " % $cmdline\n";
# }
# }
#
# {
# my $desc = $args{program_description} //
# $meta->{'description.alt.env.cmdline'} // $meta->{description};
# last unless $desc;
# $desc =~ s/\A\n+//;
# $desc =~ s/\n+\z//;
# push @help, "\n", $desc, "\n" if $desc =~ /\S/;
# }
#
# {
# require Data::Dmp;
#
# my $opts = $clidocdata->{opts};
# last unless keys %$opts;
#
# my %options_by_cat;
# for my $optkey (keys %$opts) {
# for my $cat (@{ $opts->{$optkey}{categories} }) {
# push @{ $options_by_cat{$cat} }, $optkey;
# }
# }
#
# my $cats_spec = $clidocdata->{option_categories};
# for my $cat (sort {
# ($cats_spec->{$a}{order} // 50) <=> ($cats_spec->{$b}{order} // 50)
# || $a cmp $b }
# keys %options_by_cat) {
# my @opts = sort {length($b)<=>length($a)}
# @{ $options_by_cat{$cat} };
# my $len = length($opts[0]);
# @opts = sort {
# (my $a_without_dash = $a) =~ s/^-+//;
# (my $b_without_dash = $b) =~ s/^-+//;
# lc($a) cmp lc($b);
# } @opts;
# push @help, "\n$cat:\n";
# for my $opt (@opts) {
# my $ospec = $opts->{$opt};
# my $arg_spec = $ospec->{arg_spec};
# next if grep {$_ eq 'hidden'} @{$arg_spec->{tags} // []};
# my $is_bool = $arg_spec->{schema} &&
# $arg_spec->{schema}[0] eq 'bool';
# my $show_default = exists($ospec->{default}) &&
# !$is_bool && !$ospec->{is_base64} &&
# !$ospec->{is_json} && !$ospec->{is_yaml} &&
# !$ospec->{is_alias};
#
# my $add_sum = '';
# if ($ospec->{is_base64}) {
# $add_sum = " (as base64-encoded str)";
# } elsif ($ospec->{is_json}) {
# $add_sum = " (as JSON-encoded str)";
# } elsif ($ospec->{is_yaml}) {
# $add_sum = " (as YAML-encoded str)";
# }
#
# my $argv = '';
# if (!$ospec->{main_opt} && defined($ospec->{pos})) {
# if ($ospec->{greedy}) {
# $argv = " (=arg[$ospec->{pos}-])";
# } else {
# $argv = " (=arg[$ospec->{pos}])";
# }
# }
#
# my $cmdline_src = '';
# if (!$ospec->{main_opt} && defined($arg_spec->{cmdline_src})) {
# $cmdline_src = " (or from $arg_spec->{cmdline_src})";
# $cmdline_src =~ s!_or_!/!g;
# }
#
# push @help, sprintf(
# " %-${len}s %s%s%s%s%s\n",
# $opt,
# Text::Wrap::wrap("", " " x (2+$len+2 +2),
# $ospec->{summary}//''),
# $add_sum,
# $argv,
# $cmdline_src,
# ($show_default && defined($ospec->{default}) ?
# " [".Data::Dmp::dmp($ospec->{default})."]":""),
#
# );
script/rsybak view on Meta::CPAN
# pos => 0,
# },
# meta_is_normalized => {
# schema => 'bool*',
# },
# common_opts => {
# summary => 'Will be passed to gen_getopt_long_spec_from_meta()',
# schema => 'hash*',
# },
# ggls_res => {
# summary => 'Full result from gen_getopt_long_spec_from_meta()',
# schema => 'array*',
# description => <<'_',
#
#If you already call <pm:Perinci::Sub::GetArgs::Argv>'s
#`gen_getopt_long_spec_from_meta()`, you can pass the _full_ enveloped result
#here, to avoid calculating twice. What will be useful for the function is the
#extra result in result metadata (`func.*` keys in `$res->[3]` hash).
#
#_
# },
# per_arg_json => {
# schema => 'bool',
# summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
# },
# per_arg_yaml => {
# schema => 'bool',
# summary => 'Pass per_arg_json=1 to Perinci::Sub::GetArgs::Argv',
# },
# lang => {
# schema => 'str*',
# },
# },
# result => {
# schema => 'hash*',
# },
#};
#sub gen_cli_doc_data_from_meta {
# require Getopt::Long::Negate::EN;
#
# my %args = @_;
#
# my $lang = $args{lang};
# my $meta = $args{meta} or return [400, 'Please specify meta'];
# my $common_opts = $args{common_opts};
# unless ($args{meta_is_normalized}) {
# require Perinci::Sub::Normalize;
# $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
# }
# my $ggls_res = $args{ggls_res} // do {
# require Perinci::Sub::GetArgs::Argv;
# Perinci::Sub::GetArgs::Argv::gen_getopt_long_spec_from_meta(
# meta=>$meta, meta_is_normalized=>1, common_opts=>$common_opts,
# per_arg_json => $args{per_arg_json},
# per_arg_yaml => $args{per_arg_yaml},
# );
# };
# $ggls_res->[0] == 200 or return $ggls_res;
#
# my $args_prop = $meta->{args} // {};
# my $clidocdata = {
# option_categories => {},
# example_categories => {},
# };
#
# {
# my @args;
# my %args_prop = %$args_prop;
# my $max_pos = -1;
# for (values %args_prop) {
# $max_pos = $_->{pos}
# if defined($_->{pos}) && $_->{pos} > $max_pos;
# }
# my $pos = 0;
# while ($pos <= $max_pos) {
# my ($arg, $arg_spec);
# for (keys %args_prop) {
# $arg_spec = $args_prop{$_};
# if (defined($arg_spec->{pos}) && $arg_spec->{pos}==$pos) {
# $arg = $_;
# last;
# }
# }
# $pos++;
# next unless defined($arg);
# if ($arg_spec->{greedy}) {
# $arg = $arg_spec->{'x.name.singular'}
# if $arg_spec->{'x.name.is_plural'} &&
# defined $arg_spec->{'x.name.singular'};
# }
# if ($arg_spec->{req}) {
# push @args, "<$arg>";
# } else {
# push @args, "[$arg]";
# }
# $args[-1] .= " ..." if $arg_spec->{greedy};
# delete $args_prop{$arg};
# }
# unshift @args, "[options]" if keys(%args_prop) || keys(%$common_opts);
# $clidocdata->{usage_line} = "[[prog]]".
# (@args ? " ".join(" ", @args) : "");
# }
#
# my %opts;
# {
# my $ospecs = $ggls_res->[3]{'func.specmeta'};
# my (@k, @k_aliases);
# OSPEC1:
# for (sort keys %$ospecs) {
# my $ospec = $ospecs->{$_};
# {
# last unless $ospec->{is_alias};
# next if $ospec->{is_code};
# my $arg_spec = $args_prop->{$ospec->{arg}};
# my $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
# next if $alias_spec->{summary};
# push @k_aliases, $_;
# next OSPEC1;
# }
# push @k, $_;
# }
#
# my %negs;
#
# OSPEC2:
# while (@k) {
# my $k = shift @k;
# my $ospec = $ospecs->{$k};
# my $opt;
# my $optkey;
#
# if ($ospec->{is_alias} || defined($ospec->{arg})) {
# my $arg_spec;
# my $alias_spec;
#
# if ($ospec->{is_alias}) {
#
# $arg_spec = $args_prop->{ $ospec->{arg} };
# $alias_spec = $arg_spec->{cmdline_aliases}{$ospec->{alias}};
# my $rimeta = rimeta($alias_spec);
# $optkey = _fmt_opt($arg_spec, $ospec);
# $opt = {
# opt_parsed => $ospec->{parsed},
# orig_opt => $k,
# is_alias => 1,
# alias_for => $ospec->{alias_for},
# summary => $rimeta->langprop({lang=>$lang}, 'summary') //
# "Alias for "._dash_prefix($ospec->{parsed}{opts}[0]),
# description =>
# $rimeta->langprop({lang=>$lang}, 'description'),
# };
# } else {
#
# $arg_spec = $args_prop->{$ospec->{arg}};
# my $rimeta = rimeta($arg_spec);
# $opt = {
# opt_parsed => $ospec->{parsed},
# orig_opt => $k,
# };
#
# if (defined($ospec->{is_neg})) {
# my $default = $arg_spec->{default} //
# $arg_spec->{schema}[1]{default};
# next OSPEC2 if $default && !$ospec->{is_neg};
# next OSPEC2 if !$default && $ospec->{is_neg};
# if ($ospec->{is_neg}) {
# next OSPEC2 if $negs{$ospec->{arg}}++;
# }
# }
#
# if ($ospec->{is_neg}) {
# $opt->{summary} =
# $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not');
# } elsif (defined $ospec->{is_neg}) {
# $opt->{summary} =
# $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.yes') //
# $rimeta->langprop({lang=>$lang}, 'summary');
# } elsif (($ospec->{parsed}{type}//'') eq 's@') {
# $opt->{summary} =
# $rimeta->langprop({lang=>$lang}, 'summary.alt.plurality.singular') //
# $rimeta->langprop({lang=>$lang}, 'summary');
# } else {
# $opt->{summary} =
# $rimeta->langprop({lang=>$lang}, 'summary');
# }
# $opt->{description} =
# $rimeta->langprop({lang=>$lang}, 'description');
#
# my @aliases;
# my $j = $#k_aliases;
# while ($j >= 0) {
# my $aospec = $ospecs->{ $k_aliases[$j] };
# {
# last unless $aospec->{arg} eq $ospec->{arg};
# push @aliases, $aospec;
# splice @k_aliases, $j, 1;
# }
# $j--;
# }
#
# $optkey = _fmt_opt($arg_spec, $ospec, @aliases);
# }
#
# $opt->{arg_spec} = $arg_spec;
# $opt->{alias_spec} = $alias_spec if $alias_spec;
#
# for (qw/arg fqarg is_base64 is_json is_yaml/) {
# $opt->{$_} = $ospec->{$_} if defined $ospec->{$_};
# }
#
# for (qw/req pos greedy is_password links tags/) {
# $opt->{$_} = $arg_spec->{$_} if defined $arg_spec->{$_};
# }
#
# {
# local $arg_spec->{tags} = ['category0:main']
# if !$arg_spec->{tags} || !@{$arg_spec->{tags}};
# _add_category_from_spec($clidocdata->{option_categories},
# $opt, $arg_spec, "options", 1);
# }
# _add_default_from_arg_spec($opt, $arg_spec);
#
# } else {
#
# my $spec = $common_opts->{$ospec->{common_opt}};
#
# my $show_neg = $ospec->{parsed}{is_neg} && $spec->{default};
#
# local $ospec->{parsed}{opts} = do {
# my @opts = Getopt::Long::Negate::EN::negations_for_option(
# $ospec->{parsed}{opts}[0]);
# [ $opts[0] ];
# } if $show_neg;
#
# $optkey = _fmt_opt($spec, $ospec);
# my $rimeta = rimeta($spec);
# $opt = {
# opt_parsed => $ospec->{parsed},
# orig_opt => $k,
# common_opt => $ospec->{common_opt},
# common_opt_spec => $spec,
# summary => $show_neg ?
# $rimeta->langprop({lang=>$lang}, 'summary.alt.bool.not') :
# $rimeta->langprop({lang=>$lang}, 'summary'),
# (schema => $spec->{schema}) x !!$spec->{schema},
# ('x.schema.entity' => $spec->{'x.schema.entity'}) x !!$spec->{'x.schema.entity'},
# ('x.schema.element_entity' => $spec->{'x.schema.element_entity'}) x !!$spec->{'x.schema.element_entity'},
# description =>
# $rimeta->langprop({lang=>$lang}, 'description'),
# (default => $spec->{default}) x !!(exists($spec->{default}) && !$show_neg),
# };
#
# _add_category_from_spec($clidocdata->{option_categories},
# $opt, $spec, "options", 1);
#
# }
#
# $opts{$optkey} = $opt;
# }
#
# OPT1:
# for my $k (keys %opts) {
# my $opt = $opts{$k};
# next unless $opt->{is_alias} || $opt->{is_base64} ||
# $opt->{is_json} || $opt->{is_yaml};
# for my $k2 (keys %opts) {
# my $arg_opt = $opts{$k2};
# next if $arg_opt->{is_alias} || $arg_opt->{is_base64} ||
# $arg_opt->{is_json} || $arg_opt->{is_yaml};
# next unless defined($arg_opt->{arg}) &&
# $arg_opt->{arg} eq $opt->{arg};
# $opt->{main_opt} = $k2;
# next OPT1;
# }
# }
#
# }
# $clidocdata->{opts} = \%opts;
#
# my @examples;
# {
# my $examples = $meta->{examples} // [];
# my $has_cats = _has_cats($examples);
#
# for my $eg (@$examples) {
# my $rimeta = rimeta($eg);
# my $argv;
# my $cmdline;
# if (defined($eg->{src})) {
# if ($eg->{src_plang} =~ /^(sh|bash)$/) {
# $cmdline = $eg->{src};
# } else {
# next;
# }
# } else {
# require String::ShellQuote;
# if ($eg->{argv}) {
# $argv = $eg->{argv};
# } else {
# require Perinci::Sub::ConvertArgs::Argv;
# my $res = Perinci::Sub::ConvertArgs::Argv::convert_args_to_argv(
# args => $eg->{args}, meta => $meta, use_pos => 1);
# return err($res, 500, "Can't convert args to argv")
# unless $res->[0] == 200;
# $argv = $res->[2];
# }
# $cmdline = "[[prog]]";
# for my $arg (@$argv) {
# my $qarg = String::ShellQuote::shell_quote($arg);
# $cmdline .= " $qarg";
# }
# }
# my $egdata = {
# cmdline => $cmdline,
# summary => $rimeta->langprop({lang=>$lang}, 'summary'),
# description => $rimeta->langprop({lang=>$lang}, 'description'),
# example_spec => $eg,
# };
# _add_category_from_spec($clidocdata->{example_categories},
# $egdata, $eg, "examples", $has_cats);
# push @examples, $egdata;
# }
# }
# $clidocdata->{examples} = \@examples;
#
# [200, "OK", $clidocdata];
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31';
#our $VERSION = '0.46';
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# err
# caller
# warn_err
# die_err
# gen_modified_sub
# gen_curried_sub
# );
#
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Helper when writing functions',
#};
#
#our $STACK_TRACE;
#our @_c;
#our $_i;
#sub err {
# require Scalar::Util;
#
# my @caller = CORE::caller(1);
# if (!@caller) {
# @caller = ("main", "-e", 1, "program");
# }
#
# my ($status, $msg, $meta, $prev);
#
# for (@_) {
# my $ref = ref($_);
# if ($ref eq 'ARRAY') { $prev = $_ }
# elsif ($ref eq 'HASH') { $meta = $_ }
# elsif (!$ref) {
# if (Scalar::Util::looks_like_number($_)) {
# $status = $_;
# } else {
# $msg = $_;
# }
# }
# }
#
( run in 1.691 second using v1.01-cache-2.11-cpan-2398b32b56e )