File Coverage

blib/lib/App/Rad/Help.pm

Criterion	Covered	Total	%
statement	12	57	21.0
branch	0	24	0.0
condition			n/a
subroutine	4	10	40.0
pod	5	6	83.3
total	21	97	21.6

package App::Rad::Help;
use Attribute::Handlers;
use strict;
use warnings;

our $VERSION = '0.03';

sub load {
    my ($self, $c) = @_;
    $c->register('help', \&help, 'show syntax and available commands');
}

# shows specific help commands
# TODO: context specific help,
# such as "myapp.pl help command"
sub help {
    my $c = shift;
    return usage($c) . "\n\n" . helpstr($c);
}

sub usage {
    my $c = shift;
    my $cmd;
    $cmd = $c->argv->[0] if $c->is_command($c->argv->[0]);
    return "Usage: $0 command [arguments]" unless $cmd;
    my %options = %{ $c->{'_commands'}->{$cmd}->{opts} };
    my @opts;
    @opts = map {"-" . ("-" x (length != 1)) . "$_="
            . (join " ", ((uc($options{$_}->{type}))
               x (exists $options{$_}->{arguments} ? $options{$_}->{arguments} : 1))) }
                  sort grep {$options{$_}->{required}} keys %options;
    push @opts, map {"[-" . ("-" x (length != 1)) . "$_="
            . join(" ", (uc($options{$_}->{type}))
               x (exists $options{$_}->{arguments} ? $options{$_}->{arguments} : 1)) . "]"}
                  sort grep {not $options{$_}->{required}} keys %options;
    #print $c->{'_commands'}->{$cmd}, $/;

    return "Usage: $0 $cmd @opts";
}

sub helpstr {
    my $c = shift;
    my $cmd;
    $cmd = $c->argv->[0] if $c->is_command($c->argv->[0]);
    unless($cmd) {
        my $string = "Available Commands:\n";


        # get length of largest command name
        my $len = 0;
        foreach ( sort $c->commands() ) {
            $len = length($_) if (length($_) > $len);
        }

        # format help string
        foreach ( sort $c->commands() ) {
            $string .= sprintf "    %-*s\t%s\n", $len, $_,
                               defined ($c->{'_commands'}->{$_}->help)
                               ? $c->{'_commands'}->{$_}->help
                               : ''
                               ;
                    ;
        }
        return $string;
    } else {
        my %options = %{ $c->{'_commands'}->{$cmd}->{opts} };
        my $string = "Available Options:\n";


        # get length of largest command name
        my $len = 0;
        foreach ( sort keys %options ) {
            $len = length($_) if (length($_) > $len);
        }

        # format help string
        foreach ( sort keys %options ) {
            $string .= sprintf "    %-*s\t%s\n", $len, $_,
                               defined ($options{$_}->{help})
                               ? $options{$_}->{help}
                               : ''
                               ;
                    ;
        }
        return $string;
    }
}


{
my %help_attr = ();
sub UNIVERSAL::Help :ATTR(CODE) {
    my ($package, $symbol, undef, undef, $data) = (@_);

    if ($package eq 'main') {
        # If data is a single word, it is received as an array ref. Don't ask.
        $data = join(' ', @$data) if ref($data) eq 'ARRAY';
        $help_attr{ *{$symbol}{NAME} } = $data;
    }
}

sub get_help_attr_for {
    my ($self, $cmd) = (@_);
    return $help_attr{$cmd};
}
}
42;
__END__