App-Spec

 view release on metacpan or  search on metacpan

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

sub usage {
    my ($self, %args) = @_;
    my $cmds = $args{commands};
    my %highlights = %{ $args{highlights} || {} };
    my $colored = $args{colored} || sub { $_[1] };
    my $appname = $self->name;

    my $abstract = $self->abstract // '';
    my $title = $self->title;
    my ($options, $parameters, $subcmds) = $self->_gather_options_parameters($cmds);
    my $header = $colored->(['bold'], "$appname - $title");
    my $usage = <<"EOM";
$header
$abstract

EOM

    my $body = '';
    my $usage_header = $colored->([qw/ bold /], "Usage:");
    $usage .= "$usage_header $appname";
    $usage .= " @$cmds" if @$cmds;
    if (keys %$subcmds) {
        my $maxlength = 0;
        my @table;
        my $usage_string = "<subcommands>";
        my $header = "Subcommands:";
        if ($highlights{subcommands}) {
            $colored->([qw/ bold red /], $usage_string);
            $colored->([qw/ bold red /], $header);
        }
        else {
            $colored->([qw/ bold /], $header);
        }
        $usage .= " $usage_string";
        $body .= "$header\n";

        my %keys;
        @keys{ keys %$subcmds } = ();
        my @keys;
        if (@$cmds) {
            @keys = sort keys %keys;
        }

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

        my $maxlength = 0;
        my @table;
        my @highlights;
        for my $param (@$parameters) {
            my $name = $param->name;
            my $highlight = $highlights{parameters}->{ $name };
            push @highlights, $highlight ? 1 : 0;
            my $summary = $param->summary;
            my $param_usage_header = $param->to_usage_header;
            if ($highlight) {
                $colored->([qw/ bold red /], $param_usage_header);
            }
            $usage .= " " . $param_usage_header;
            my ($req, $multi) = (' ', '  ');
            if ($param->required) {
                $req = "*";
            }
            if ($param->mapping) {
                $multi = '{}';
            }
            elsif ($param->multiple) {

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

            my $flags = $self->_param_flags_string($param);

            my @lines = split m/\n/, $summary;
            push @table, [$name, $req, $multi, ($lines[0] // '') . $flags];
            push @table, ['', ' ', '  ', $_] for map { s/^ +//; $_ } @lines[1 .. $#lines];
            if (length $name > $maxlength) {
                $maxlength = length $name;
            }
        }
        my $parameters_string = $colored->([qw/ bold /], "Parameters:");
        $body .= "$parameters_string\n";
        my @lines = $self->_output_table(\@table, [$maxlength]);
        my $lines = $self->_colorize_lines(\@lines, \@highlights, $colored);
        $body .= $lines;
    }

    if (@$options) {
        my @highlights;
        $usage .= " [options]";
        my $maxlength = 0;

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

            elsif ($opt->multiple) {
                $multi = '[]';
            }

            my $flags = $self->_param_flags_string($opt);

            my @lines = split m/\n/, $summary;
            push @table, [$string, $req, $multi, ($lines[0] // '') . $flags];
            push @table, ['', ' ', '  ', $_ ] for map { s/^ +//; $_ } @lines[1 .. $#lines];
        }
        my $options_string = $colored->([qw/ bold /], "Options:");
        $body .= "\n$options_string\n";
        my @lines = $self->_output_table(\@table, [$maxlength]);
        my $lines = $self->_colorize_lines(\@lines, \@highlights, $colored);
        $body .= $lines;
    }

    return "$usage\n\n$body";
}

sub _param_flags_string {

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

    my $flags = @flags ? " (" . join("; ", @flags) . ")" : '';
    return $flags;
}

sub _colorize_lines {
    my ($self, $lines, $highlights, $colored) = @_;
    my $output = '';
    for my $i (0 .. $#$lines) {
        my $line = $lines->[ $i ];
        if ($highlights->[ $i ]) {
            $colored->([qw/ bold red /], $line);
        }
        $output .= $line;
    }
    return $output;
}

sub _output_table {
    my ($self, $table, $lengths) = @_;
    my @lines;
    my @lengths = map {

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

    return;
}

sub colorize_error {
    my ($self, $msg) = @_;
    $msg = $self->colored('err', [qw/ error /], $msg) . "\n";
}

sub colored {
    my ($self, $out, $colors, $msg) = @_;
    $colors = [ map { $_ eq 'error' ? qw/ bold red / : $_ } @$colors ];
    require Term::ANSIColor;
    $self->colorize($out)
        and $msg = Term::ANSIColor::colored($colors, $msg);
    return $msg;
}

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

    for my $event (sort keys %args) {

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

    # or
    my $text = "Hurray";
    $colored->(['green'], $text);

Returns a coderef which you can use for coloring

=item colorize_error

    my $msg = $run->colorize_error("ouch");

Returns the message in the standard error color (bold red).

=item error_output

    $run->error_output;

Outputs any errors.

Calls C<halt>

=item event_globaloptions