File Coverage

blib/lib/App/Rad/Help.pm

Criterion	Covered	Total	%
statement	17	34	50.0
branch	3	12	25.0
condition	2	3	66.6
subroutine	6	10	60.0
pod	5	6	83.3
total	33	65	50.7

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() . "\n\n" . helpstr($c);
}

sub usage {
    return "Usage: $0 command [arguments]";
}

sub helpstr {
    my $c = shift;

    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;
}


{
my %help_attr = ();
sub UNIVERSAL::Help :ATTR(CODE) {
     my ($package, $symbol, $ref, $attr, $data, $phase, $filename, $linenum) = @_;

    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 register_help {
    my ($self, $c, $cmd, $helptext) = @_;

    if ((not defined $helptext) && (defined $help_attr{$cmd})) {
        $helptext = $help_attr{$cmd};
    }

    # we do $helptext // undef as it would issue a warning otherwise
    $c->{'_commands'}->{$cmd}->{'help'} = defined $helptext
                                        ? $helptext
                                        : undef
                                        ;
}

}
42;
__END__