view release on metacpan or  search on metacpan

lib/Perinci/CmdLine/Classic/Role/Help.pm  view on Meta::CPAN

sub _help_add_heading {
    my ($self, $r, $heading) = @_;
    $self->_help_add_row($r, [$self->_color('heading', $heading)]);
}

sub _color {
    my ($self, $item_name, $text) = @_;
    my $color_code = $item_name ?
        $self->{color_theme_obj}->get_item_color_as_ansi($item_name) : "";
    my $reset_code = $color_code ? "\e[0m" : "";
    "$color_code$text$reset_code";
}

sub help_section_summary {
    my ($self, $r) = @_;

    my $summary = rimeta($r->{_help_meta})->langprop("summary");
    return unless $summary;

    my $name = $self->get_program_and_subcommand_name($r);
    my $ct = join(
        "",
        $self->_color('program_name', $name),
        ($name && $summary ? ' - ' : ''),
        $summary // "",
    );
    $self->_help_add_row($r, [$ct], {wrap=>1});
}

sub help_section_usage {
    my ($self, $r) = @_;

    my $co = $self->common_opts;
    my @con = grep {
        my $cov = $co->{$_};
        my $show = $cov->{show_in_usage} // 1;
        for ($show) { if (ref($_) eq 'CODE') { $_ = $_->($self, $r) } }
        $show;
    } sort {
        ($co->{$a}{order}//1) <=> ($co->{$b}{order}//1) || $a cmp $b
    } keys %$co;

    my $pn = $self->_color(
        'program_name', $self->get_program_and_subcommand_name($r));
    my $ct = "";
    for my $con (@con) {
        my $cov = $co->{$con};
        next unless $cov->{usage};
        $ct .= ($ct ? "\n" : "") . $pn . " " . __($cov->{usage});
    }
    if ($self->subcommands && !$r->{subcommand_name}) {
        if (defined $self->default_subcommand) {
            $ct .= ($ct ? "\n" : "") . $pn .
                " " . __("--cmd=<other-subcommand> [options]");
        } else {
            $ct .= ($ct ? "\n" : "") . $pn .
                " " . __("<subcommand> [options]");
        }
    } else {
        my $usage = $r->{_help_clidocdata}{usage_line};
        $usage =~ s/\[\[prog\]\]/$pn/;
        $usage =~ s/\[options\]/__("[options]")/e;
        $ct .= ($ct ? "\n" : "") . $usage;
    }
    $self->_help_add_heading($r, __("Usage"));
    $self->_help_add_row($r, [$ct], {indent=>1});
}

sub help_section_options {
    my ($self, $r) = @_;

    my $opts = $r->{_help_clidocdata}{opts};
    return unless keys %$opts;

    my $verbose = $r->{_help_verbose};
    my $info = $r->{_help_info};
    my $meta = $r->{_help_meta};
    my $args_p = $meta->{args};
    my $sc = $self->subcommands;

    # group options by raw category, e.g. $cats{""} (for options
    # without category and common options) or $cat{"cat1"}.
    my %cats; # val = [ospec, ...]

    for (keys %$opts) {
        push @{ $cats{$opts->{$_}{raw_category} // ''} }, $_;
    }

    for my $cat (sort keys %cats) {
        # find the longest option
        my @opts = sort {length($b)<=>length($a)} @{ $cats{$cat} };
        my $len = length($opts[0]);
        # sort again by name
        @opts = sort {
            (my $a_without_dash = $a) =~ s/^-+//;
            (my $b_without_dash = $b) =~ s/^-+//;
            lc($a) cmp lc($b);
        } @opts;

        my $cat_title;
        if ($cat eq '') {
            $cat_title = __("Options");
        } else {
            $cat_title = __x("{category} options", category=>ucfirst($cat));
        }
        $self->_help_add_heading($r, $cat_title);

        if ($verbose) {
            for my $opt_name (@opts) {
                my $opt_spec = $opts->{$opt_name};
                my $arg_spec = $opt_spec->{arg_spec};
                my $ct = $self->_color('option_name', $opt_name);
                # BEGIN DUPE1
                if ($arg_spec && !$opt_spec->{main_opt} &&
                        defined($arg_spec->{pos})) {
                    if ($arg_spec->{slurpy} // $arg_spec->{greedy}) {
                        $ct .= " (=arg[$arg_spec->{pos}-])";
                    } else {
                        $ct .= " (=arg[$arg_spec->{pos}])";
                    }
                }
                if ($arg_spec && !$opt_spec->{main_opt} &&
                        defined($arg_spec->{cmdline_src})) {
                    $ct .= " (or from $arg_spec->{cmdline_src})";
                    $ct =~ s!_or_!/!;
                }
                # END DUPE1
                $self->_help_add_row($r, [$ct], {indent=>1});

                if ($opt_spec->{summary} || $opt_spec->{description}) {
                    my $ct = "";
                    $ct .= ($ct ? "\n\n":"")."$opt_spec->{summary}."

lib/Perinci/CmdLine/Classic/Role/Help.pm  view on Meta::CPAN

        for (@shown_scs) {
            my $summary = rimeta($_)->langprop("summary");
            $self->_help_add_row(
                $r,
                [$self->_color('program_name', $_->{name}), $summary],
                {column_widths=>[-17, -40], indent=>1});
        }
    } else {
        # for compactness, display in columns
        my $tw = $self->term_width;
        my $columns = int($tw/25); $columns = 1 if $columns < 1;
            while (1) {
                my @row;
                for (1..$columns) {
                    last unless @shown_scs;
                    my $sc = shift @shown_scs;
                    push @row, $sc->{name};
                }
                last unless @row;
                for (@row+1 .. $columns) { push @row, "" }
                $self->_help_add_row($r, \@row, {indent=>1});
            }

    }
}

sub help_section_hints {
    my ($self, $r) = @_;

    my $verbose = $r->{_help_verbose};
    my @hints;
    unless ($verbose) {
        push @hints, N__("For more complete help, use '--help --verbose'");
    }
    if ($r->{_help_hide_some_subcommands}) {
        push @hints,
            N__("To see all available subcommands, use '--subcommands'");
    }
    return unless @hints;

    $self->_help_add_row(
        $r, [join(" ", map { __($_)."." } @hints)], {wrap=>1});
}

sub help_section_description {
    my ($self, $r) = @_;

    my $desc = rimeta($r->{_help_meta})->langprop("description") //
        $self->description;
    return unless $desc;

    $self->_help_add_heading($r, __("Description"));
    $self->_help_add_row($r, [$desc], {wrap=>1, indent=>1});
}

sub help_section_examples {
    my ($self, $r) = @_;

    my $verbose = $r->{_help_verbose};
    my $meta = $r->{_help_meta};
    my $egs = $r->{_help_clidocdata}{examples};
    return unless $egs && @$egs;

    $self->_help_add_heading($r, __("Examples"));
    my $pn = $self->_color(
        'program_name', $self->get_program_and_subcommand_name($r));
    for my $eg (@$egs) {
        my $cmdline = $eg->{cmdline};
        $cmdline =~ s/\[\[prog\]\]/$pn/;
        $self->_help_add_row($r, ["% $cmdline"], {indent=>1});
        if ($verbose) {
            my $ct = "";
            if ($eg->{summary}) { $ct .= "$eg->{summary}." }
            if ($eg->{description}) { $ct .= "\n\n$eg->{description}" }
            $self->_help_add_row($r, [$ct], {indent=>2}) if $ct;
        }
    }
}

sub help_section_result {
    my ($self, $r) = @_;

    my $meta   = $r->{_help_meta};
    my $rmeta  = $meta->{result};
    my $rmetao = rimeta($rmeta);
    my $text;

    my $summary = $rmetao->langprop('summary') // '';
    my $desc    = $rmetao->langprop('description') // '';
    $text = $summary . ($summary ? "\n\n" : "") . $desc;

    # collect handler
    my %handlers;
    for my $k0 (keys %$rmeta) {
        my $v = $rmeta->{$k0};

        my $k = $k0; $k =~ s/\..+//;
        next if $k =~ /\A_/;

        # check builtin result spec key
        next if $k =~ /\A(
                           summary|description|tags|default_lang|
                           schema|
                           x
                       )\z/x;

        # try a property module first
        require "Perinci/Sub/Property/result/$k.pm";
        my $meth = "help_hookmeta_result__$k";
        unless ($self->can($meth)) {
            die "No help handler for property result/$k0 ($meth)";
        }
        my $hmeta = $self->$meth;
        $handlers{$k} = {
            prio => $hmeta->{prio},
            meth => "help_hook_result__$k",
        };
    }

    # call all the handlers in order
    for my $k (sort {$handlers{$a}{prio} <=> $handlers{$b}{prio}}
                   keys %handlers) {
        my $h = $handlers{$k};
        my $meth = $h->{meth};
        my $t = $self->$meth($r);
        $text .= $t if $t;
    }

    return unless length $text;

    $self->_help_add_heading($r, __("Result"));
    $self->_help_add_row($r, [$text], {wrap=>1, indent=>1});
}

sub help_section_links {
    # not yet
}

sub action_help {
    my ($self, $r) = @_;

    $r->{_help_buf} = '';

    my $verbose = $ENV{VERBOSE} // 0;
    local $r->{_help_verbose} = $verbose;

    # get function metadata first
    unless ($r->{_help_meta}) {
        my $url = $r->{subcommand_data}{url} // $self->url;
        my $res = $self->riap_client->request(info => $url);
        die [500, "Can't info '$url': $res->[0] - $res->[1]"]
            unless $res->[0] == 200;
        $r->{_help_info} = $res->[2];
        $res = $self->riap_client->request(meta => $url);
        die [500, "Can't meta '$url': $res->[0] - $res->[1]"]
            unless $res->[0] == 200;
        $r->{_help_meta} = $res->[2]; # cache here
    }

    # get cli opt spec
    unless ($r->{_help_clidocdata}) {
        require Perinci::Sub::To::CLIDocData;
        my $res = Perinci::Sub::To::CLIDocData::gen_cli_doc_data_from_meta(
            meta => $r->{_help_meta}, meta_is_normalized => 1,
            common_opts  => $self->common_opts,
            per_arg_json => $self->per_arg_json,
            per_arg_yaml => $self->per_arg_yaml,
        );
        die [500, "Can't gen_cli_doc_data_from_meta: $res->[0] - $res->[1]"]
            unless $res->[0] == 200;
        $r->{_help_clidocdata} = $res->[2]; # cache here
    }

    # ux: since --verbose will potentially show lots of paragraph text, let's
    # default to 80 and not wider width, unless user specifically requests
    # column width via COLUMNS.
    if ($verbose && !defined($ENV{COLUMNS}) && $self->term_width > 80) {
        $self->term_width(80);
    }

    # determine which help sections should we generate
    my @hsects;
    if ($verbose) {
        @hsects = (
            'summary',
            'usage',
            'subcommands',
            'examples',
            'description',
            'options',
            'result',
            'links',
            'hints',
        );
    } else {
        @hsects = (
            'summary',
            'usage',
            'subcommands',
            'examples',
            'options',
            'hints',
        );
    }

    for my $s (@hsects) {
        my $meth = "help_section_$s";
        #say "D:$meth";
        #$log->tracef("=> $meth()");
        $self->$meth($r);
    }
    $self->_help_draw_curtbl($r);
    [200, "OK", $r->{_help_buf}, {"cmdline.skip_format"=>1}];
}

1;
# ABSTRACT: Help-related routines

__END__

=pod

=encoding UTF-8

=head1 NAME

Perinci::CmdLine::Classic::Role::Help - Help-related routines

=head1 VERSION

This document describes version 1.818 of Perinci::CmdLine::Classic::Role::Help (from Perl distribution Perinci-CmdLine-Classic), released on 2023-10-30.