view release on metacpan or  search on metacpan

lib/App/Spec/Pod.pm  view on Meta::CPAN

        if (@$options) {
            $usage .= " [options]";
            $option_string = "Options:\n\n" . $self->options2pod(
                options => $options,
            );
        }

        if (length $option_string) {
            $desc .= "$option_string\n";
        }

        my $param_string = '';
        if (@$parameters) {
            $param_string = "Parameters:\n\n" . $self->params2pod(
                parameters => $parameters,
            );
            for my $param (@$parameters) {
                my $name = $param->name;
                my $required = $param->required;
                $usage .= " " . $param->to_usage_header;
            }
        }
        if (length $param_string) {
            $desc .= $param_string;
        }

        my $pod = <<"EOM";
\=head3 @$previous $name

    $usage

$desc
EOM
        if (keys %$subcmds and $name ne "help") {
            my @sub = $self->subcommand_pod(
                previous => [@$previous, $name],
                commands => $subcmds,
            );
            $pod .= join '', @sub;
        }
        push @pod, $pod;
    }
    return @pod;
}

sub params2pod {
    my ($self, %args) = @_;
    my $params = $args{parameters};
    my @rows;
    for my $param (@$params) {
        my $required = $param->required ? '*' : '';
        my $summary = $param->summary;
        my $multi = '';
        if ($param->mapping) {
            $multi = '{}';
        }
        elsif ($param->multiple) {
            $multi = '[]';
        }
        my $flags = $self->spec->_param_flags_string($param);
        my @lines = split m/\n/, $summary;
        push @rows, ["    " . $param->name, " " . $required, $multi, ($lines[0] // '') . $flags];
        push @rows, ["    " , " ", '', $_] for map {s/^ +//; $_ } @lines[1 .. $#lines];
    }
    my $test = $self->simple_table(\@rows);
    return $test;
}

sub simple_table {
    my ($self, $rows) = @_;
    my @widths;

    for my $row (@$rows) {
        for my $i (0 .. $#$row) {
            my $col = $row->[ $i ];
            $widths[ $i ] ||= 0;
            if ( $widths[ $i ] < length $col) {
                $widths[ $i ] = length $col;
            }
        }
    }
    my $format = join ' ', map { "%-" . ($_ || 0) . "s" } @widths;
    my @lines;
    for my $row (@$rows) {
        my $string = sprintf "$format\n", map { $_ // '' } @$row;
        push @lines, $string;
    }
    return join '', @lines;

}

sub options2pod {
    my ($self, %args) = @_;
    my $options = $args{options};
    my @rows;
    for my $opt (@$options) {
        my $name = $opt->name;
        my $aliases = $opt->aliases;
        my $summary = $opt->summary;
        my $required = $opt->required ? '*' : '';
        my $multi = '';
        if ($opt->mapping) {
            $multi = '{}';
        }
        elsif ($opt->multiple) {
            $multi = '[]';
        }
        my @names = map {
            length $_ > 1 ? "--$_" : "-$_"
        } ($name, @$aliases);
        my $flags = $self->spec->_param_flags_string($opt);
        my @lines = split m/\n/, $summary;
        push @rows, ["    @names", " " . $required, $multi, ($lines[0] // '') . $flags];
        push @rows, ["    ", " " , '', $_ ] for map {s/^ +//; $_ } @lines[1 .. $#lines];
    }
    my $test = $self->simple_table(\@rows);
    return $test;
}

sub markup {
    my ($self, %args) = @_;
    my $text = $args{text};
    return unless defined $$text;
    my $markup = $self->spec->markup // '';
    if ($markup eq "swim") {
        $$text = $self->swim2pod($$text);
    }
}
sub swim2pod {
    my ($self, $text) = @_;
    require Swim;
    my $swim = Swim->new(text => $text);
    my $pod = $swim->to_pod;
}

1;

__END__

=pod

=head1 NAME

App::Spec::Pod - Generates Pod from App::Spec objects

=head1 SYNOPSIS

    my $generator = App::Spec::Pod->new(
        spec => $appspec,
    );
    my $pod = $generator->generate;

=head1 METHODS

=over 4

=item generate

    my $pod = $generator->generate;

=item markup

    $pod->markup(text => \$abstract);

Applies markup defined in the spec to the text argument.

=item options2pod

    my $option_string = "Options:\n\n" . $self->options2pod(
        options => $options,
    );