Perinci-CmdLine-POD
view release on metacpan or search on metacpan
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
if (($ospec->{orig_opt} // '') =~ /\@/) {
push @res, "Can be specified multiple times.\n\n";
} elsif (($ospec->{orig_opt} // '') =~ /\%/) {
push @res, "Each value is a name-value pair, use I<key=value> syntax. Can be specified multiple times.\n\n";
}
join "", @res;
}
sub _list_config_params {
my ($clidocdata, $filter) = @_;
my $opts = $clidocdata->{opts};
my %param2opts;
for (keys %$opts) {
my $ospec = $opts->{$_};
next unless $ospec->{common_opt} && $ospec->{common_opt_spec}{is_settable_via_config};
next if $filter && !$filter->($ospec);
my $oname = $ospec->{opt_parsed}{opts}[0];
$oname = length($oname) > 1 ? "--$oname" : "-$oname";
$param2opts{ $ospec->{common_opt} } = $oname;
}
for (keys %$opts) {
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
config_filename => $args{config_filenames},
config_dirs => $args{config_dirs},
);
}
# script has its metadata in its main:: instead of from a module, so let's
# put it there
local %main::SPEC = %{ $dump_res->[3]{'func.meta'} }
if $dump_res->[3]{'func.meta'};
# generate clidocdata(for all subcommands; if there is no subcommand then it
# is stored in key '')
my %clidocdata; # key = subcommand name
my %urls; # key = subcommand name
{
require Perinci::Sub::To::CLIDocData;
my $url = $cli->{url};
$urls{''} = $url;
my $res = $pa->request(meta => $url);
die "Can't meta $url: $res->[0] - $res->[1]"
unless $res->[0] == 200;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
$res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
meta => $metas{''},
meta_is_normalized => 0, # because riap client is specifically set not to normalize
common_opts => $cli->{common_opts},
per_arg_json => $cli->{per_arg_json},
per_arg_yaml => $cli->{per_arg_yaml},
);
die "Can't gen_cli_doc_data_from_meta: $res->[0] - $res->[1]"
unless $res->[0] == 200;
$clidocdata{''} = $res->[2];
if ($cli->{subcommands}) {
if (ref($cli->{subcommands}) eq 'CODE') {
die "Script '$args{script}': sorry, coderef 'subcommands' not ".
"supported yet";
}
for my $sc_name (keys %{ $cli->{subcommands} }) {
my $sc_spec = $cli->{subcommands}{$sc_name};
my $url = $sc_spec->{url};
$urls{$sc_name} = $url;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
}
$res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
meta => $metas{$sc_name},
meta_is_normalized => 0, # because riap client is specifically set not to normalize
common_opts => $cli->{common_opts},
per_arg_json => $cli->{per_arg_json},
per_arg_yaml => $cli->{per_arg_yaml},
);
die "Can't gen_cli_doc_data_from_meta (subcommand $sc_name): $res->[0] - $res->[1]"
unless $res->[0] == 200;
$clidocdata{$sc_name} = $res->[2];
}
}
}
my $gen_sc = $args{gen_subcommand};
if (defined $gen_sc) {
return [400, "Unknown subcommand '$gen_sc'"]
unless $metas{$gen_sc};
}
my $gen_scs = $args{gen_subcommands} // 1;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
push @{ $resmeta->{'func.sections'} }, {name=>'VERSION', content=>join("", @sectpod), ignore=>1};
push @pod, "=head1 VERSION\n\n", @sectpod;
}
# section: EXAMPLES
my $has_examples;
{
my @sectpod;
my @examples;
for my $sc_name (sort keys %clidocdata) {
if ($cli->{subcommands}) {
next unless length $sc_name;
if (defined $gen_sc) { next unless $sc_name eq $gen_sc }
}
my $i = 1;
for my $eg (@{ $clidocdata{$sc_name}{examples} }) {
# add pointer to subcommand, we need it later to show result
$eg->{_sc_name} = $sc_name;
$eg->{_i} = $i;
push @examples, $eg;
$i++;
}
}
if (@examples) {
$has_examples++;
my $num = 0;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
} elsif (defined $co_spec->{usage}) {
# text format, the next best thing
require String::PodQuote;
push @usage, "B<$program_name> ".String::PodQuote::pod_escape($co_spec->{usage})."\n\n";
}
}
if ($cli->{subcommands}) {
# 2a. show per-subcommand usage lines, if there are subcommands
if ($gen_scs) {
for my $sc_name (sort keys %clidocdata) {
next unless length $sc_name;
if (defined $gen_sc) { next unless $sc_name eq $gen_sc }
my $subcmd_usage = $clidocdata{$sc_name}->{'usage_line.alt.fmt.pod'};
$subcmd_usage =~ s/\[\[prog\]\]/$program_name $sc_name/g;
push @usage, "$subcmd_usage\n\n";
}
} else {
push @usage, "B<$program_name> [I<options>] [I<subcommand>] [I<arg>]...\n\n";
}
push @usage, "\n\n";
} else {
# 2b. show main usage line
my $main_usage = $clidocdata{''}->{'usage_line.alt.fmt.pod'};
$main_usage =~ s/\[\[prog\]\]/$program_name/g;
push @usage, "$main_usage\n\n";
}
$resmeta->{'func.usage'} = join('', @usage);
push @sectpod, @usage;
# point to examples in Examples section, if any
push @sectpod, "\n\nSee examples in the L</EXAMPLES> section.\n\n" if $has_examples;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
# section: SUBCOMMANDS
{
last unless $cli->{subcommands};
last if defined $gen_sc;
my @sectpod;
my %sc_spec_refs; # key=ref address, val=first subcommand name
my $i = -1;
for my $sc_name (sort keys %clidocdata) {
next unless length $sc_name;
$i++;
my $sc_spec = $cli->{subcommands}{$sc_name};
my $spec_same_as;
if (defined $sc_spec_refs{"$sc_spec"}) {
$spec_same_as = $sc_spec_refs{"$sc_spec"};
} else {
$sc_spec_refs{"$sc_spec"} = $sc_name;
}
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
}
push @sectpod, "=item * $sc_name\n\n";
}
} # for $sc_name
push @sectpod, "=back\n\n" unless $gen_scs;
push @{ $resmeta->{'func.sections'} }, {name=>'SUBCOMMANDS', content=>join("", @sectpod), ignore=>1};
push @pod, "=head1 SUBCOMMANDS\n\n", @sectpod;
}
my @sc_names = grep { length } sort keys %clidocdata;
# section: OPTIONS
{
my @sectpod;
push @sectpod, "C<*> marks required options.\n\n";
unless ($gen_scs) {
push @sectpod, "Each subcommand might accept additional options. See each subcommand's documentation for more details.\n\n";
}
if ($cli->{subcommands} && !defined $gen_sc) {
# currently categorize by subcommand instead of category
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
return 1 if grep { $_ eq 'common' } @{ $opts->{$name}{tags} // []};
return 1 if !$opts->{$name}{arg};
0;
};
# first display options tagged with 'common' as well as common
# option (non-function argument option, like --format or
# --log-level). these are supposed to be the same across
# subcommands.
{
my $opts = $clidocdata{ $sc_names[0] }{opts};
my @opts = sort {
(my $a_without_dash = $a) =~ s/^-+//;
(my $b_without_dash = $b) =~ s/^-+//;
lc($a) cmp lc($b);
} grep {$check_common_arg->($opts, $_)} keys %$opts;
push @sectpod, "=head2 Common options\n\n" if $gen_scs;
push @sectpod, "=over\n\n";
for (@opts) {
push @sectpod, _fmt_opt($_, $opts->{$_});
}
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
my $spec_same_as;
if (defined $sc_spec_refs{"$sc_spec"}) {
$spec_same_as = $sc_spec_refs{"$sc_spec"};
} else {
$sc_spec_refs{"$sc_spec"} = $sc_name;
}
next if defined $spec_same_as;
next if $sc_spec->{is_alias};
my $opts = $clidocdata{$sc_name}{opts};
my @opts = sort {
(my $a_without_dash = $a) =~ s/^-+//;
(my $b_without_dash = $b) =~ s/^-+//;
lc($a) cmp lc($b);
} grep {!$check_common_arg->($opts, $_)} keys %$opts;
next unless @opts;
my $sc_name_e = $sc_name =~ /\A\S+\z/ ? $sc_name : "'$sc_name'";
push @sectpod, "=head2 Options for subcommand $sc_name_e\n\n";
push @sectpod, "=over\n\n";
for (@opts) {
push @sectpod, _fmt_opt($_, $opts->{$_});
}
push @sectpod, "=back\n\n";
}
}
} else {
my $k = defined $gen_sc ? $gen_sc : '';
my $opts = $clidocdata{$k}{opts};
# find all the categories
my %options_by_cat; # val=[options...]
for my $optkey (keys %$opts) {
for my $cat (@{ $opts->{$optkey}{categories} }) {
push @{ $options_by_cat{$cat} }, $optkey;
}
}
my $cats_spec = $clidocdata{$k}{option_categories};
for my $cat (sort {
($cats_spec->{$a}{order} // 50) <=> ($cats_spec->{$b}{order} // 50)
|| $a cmp $b }
keys %options_by_cat) {
push @sectpod, "=head2 $cat\n\n"
unless keys(%options_by_cat) == 1;
my @opts = sort {
(my $a_without_dash = $a) =~ s/^-+//;
(my $b_without_dash = $b) =~ s/^-+//;
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
"List of available configuration parameters", ($gen_scs ? "" : " (note that each subcommand might have additional configuration parameter, refer to each subcommand's documentation for more details)"), ":\n\n",
);
if ($cli->{subcommands}) {
# first list the options tagged with 'common' and common options
# (non-function argument options, like --format or --log-level)
# which are supposed to be the same across subcommands.
push @sectpod, "=head2 Common for all subcommands\n\n" if $gen_scs;
my $param2opts = _list_config_params(
$clidocdata{$sc_names[0]},
sub { grep { $_ eq 'common' } @{ $_[0]->{tags} // []} || !$_[0]->{arg} });
for (sort keys %$param2opts) {
push @sectpod, " $_ (see $param2opts->{$_})\n";
}
push @sectpod, "\n";
if ($gen_scs) {
# now list the options for each subcommand
for my $sc_name (@sc_names) {
my $sc_spec = $cli->{subcommands}{$sc_name};
next if $sc_spec->{is_alias};
my $sc_name_e = $sc_name =~ /\A\S+\z/ ? $sc_name : "'$sc_name'";
push @sectpod, "=head2 Configuration for subcommand $sc_name_e\n\n";
$param2opts = _list_config_params(
$clidocdata{$sc_name},
sub { !(grep { $_ eq 'common' } @{ $_[0]->{tags} // []}) && $_[0]->{arg} });
for (sort keys %$param2opts) {
push @sectpod, " $_ (see $param2opts->{$_})\n";
}
push @sectpod, "\n";
}
}
} else {
my $param2opts = _list_config_params($clidocdata{''});
for (sort keys %$param2opts) {
push @sectpod, " $_ (see $param2opts->{$_})\n";
}
push @sectpod, "\n";
}
push @{ $resmeta->{'func.sections'} }, {name=>'CONFIGURATION FILE', content=>join("", @sectpod), ignore=>1};
push @pod, "=head1 CONFIGURATION FILE\n\n", @sectpod;
}
lib/Perinci/CmdLine/POD.pm view on Meta::CPAN
push @{ $resmeta->{'func.sections'} }, {name=>'FAQ', content=>join("", @sectpod)};
push @pod, "=head1 FAQ\n\n", @sectpod;
}
# section: SEE ALSO
{
my @sectpod;
my %seen_urls;
for my $sc_name (sort keys %clidocdata) {
my $meta = $metas{$sc_name};
next unless $meta->{links};
for my $link0 (@{ $meta->{links} }) {
my $link = ref($link0) ? $link0 : {url=>$link0};
my $url = $link->{url};
next if $seen_urls{$url}++;
if ($url =~ s!^(pm|pod|prog):(//?)?!!) {
push @sectpod, "L<$url>.";
} else {
push @sectpod, "L<$url>.";
( run in 0.669 second using v1.01-cache-2.11-cpan-454fe037f31 )