view release on metacpan or  search on metacpan

lib/Getopt/Long/Descriptive/Usage.pm  view on Meta::CPAN

use strict;
use warnings;
package Getopt::Long::Descriptive::Usage 0.114;
# ABSTRACT: the usage description for GLD

use List::Util qw(max);

#pod =head1 SYNOPSIS
#pod
#pod   use Getopt::Long::Descriptive;
#pod   my ($opt, $usage) = describe_options( ... );
#pod
#pod   $usage->text; # complete usage message
#pod
#pod   $usage->die;  # die with usage message
#pod
#pod =head1 DESCRIPTION
#pod
#pod This document only describes the methods of the Usage object.  For information
#pod on how to use L<Getopt::Long::Descriptive>, consult its documentation.
#pod
#pod =head1 METHODS
#pod
#pod =head2 new
#pod
#pod   my $usage = Getopt::Long::Descriptive::Usage->new(\%arg);
#pod
#pod You B<really> don't need to call this.  GLD will do it for you.
#pod
#pod Valid arguments are:
#pod
#pod   options     - an arrayref of options
#pod   leader_text - the text that leads the usage; this may go away!
#pod
#pod =cut

sub new {
  my ($class, $arg) = @_;

  my @to_copy = qw(leader_text options show_defaults);

  my %copy;
  @copy{ @to_copy } = @$arg{ @to_copy };

  bless \%copy => $class;
}

#pod =head2 text
#pod
#pod This returns the full text of the usage message.
#pod
#pod =cut

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

  return join qq{\n}, $self->leader_text, $self->option_text;
}

#pod =head2 leader_text
#pod
#pod This returns the text that comes at the beginning of the usage message.
#pod
#pod =cut

sub leader_text { $_[0]->{leader_text} }

#pod =head2 option_text
#pod
#pod This returns the text describing the available options.
#pod
#pod =cut

sub option_text {
  my ($self) = @_;

  my $string   = q{};

  my @options  = @{ $self->{options} || [] };
  my @specs    = map { $_->{spec} } grep { $_->{desc} ne 'spacer' } @options;
  my $length   = (max(map { _option_length($_) } @specs) || 0);
  my $spec_fmt = "    %-${length}s";

  while (@options) {
    my $opt  = shift @options;
    my $spec = $opt->{spec};
    my $desc = $opt->{desc};

    if ($desc eq 'spacer') {
      if (ref $opt->{spec}) {
        $string .= "${ $opt->{spec} }\n";
        next;
      } else {
        my @lines = $self->_split_description(0, $opt->{spec});

        $string .= length($_) ? sprintf("$spec_fmt\n", $_) : "\n" for @lines;
        next;
      }
    }

    ($spec, my $assign) = Getopt::Long::Descriptive->_strip_assignment($spec);

    my ($pre, $post) = _parse_assignment($assign);
    my @names = split /\|/, $spec;