view release on metacpan or  search on metacpan

lib/CLI/Dispatch/Help.pm  view on Meta::CPAN

package CLI::Dispatch::Help;

use strict;
use warnings;
use base qw( CLI::Dispatch::Command );
use Class::Unload;
use Class::Inspector;
use Encode;
use Pod::Simple::Text;
use Path::Tiny;
use String::CamelCase;
use Term::Encoding ();
use Try::Tiny;

my $term_encoding = eval {
  find_encoding(Term::Encoding::get_encoding())
} || 'utf8';


sub options {qw( from|decode=s to|encode=s )}

sub extra_namespaces {}

sub run {
  my ($self, @args) = @_;

  my $text;
  if ( @args ) {
    $text = $self->extract_pod( @args );
  }
  else {
    $text = $self->list_commands;
  }

  $self->output( $text );
}

sub output {
  my ($self, $text, $no_print) = @_;

  unless ( Encode::is_utf8( $text ) ) {
    $text = decode( $self->option('from') || 'utf8', $text )
  }
  $text = encode( $self->option('to') || $term_encoding, $text );

  print $text unless $no_print;

  return $text;
}

sub extract_pod {
  my ($self, $command) = @_;

  my $content = $self->_lookup( $command );

  unless ( $content ) {
    $self->logger(1) unless $self->logger;
    $self->log( warn => "$command is not found" );
    return $self->list_commands;
  }

  my $pod = $self->_parse_pod($content);

  return $self->extract_pod_body($pod);
}

sub extract_pod_body {
  my ($self, $pod) = @_;

  # remove the first ("NAME") section as the command does not
  # always belong to the same namespace as the dispatcher/script.
  # (default CLI::Dispatch namespace may be confusing for end users)
  $pod =~ s/^\S+\s+(.+?)\n(?=\S)//s;