File Coverage

lib/CLI/Dispatch/Command.pm
Criterion Covered Total %
statement 30 47 63.8
branch 13 18 72.2
condition 4 11 36.3
subroutine 7 9 77.7
pod 7 7 100.0
total 61 92 66.3


line stmt bran cond sub pod time code
1             package CLI::Dispatch::Command;
2              
3 10     10   73157 use strict;
  10         23  
  10         320  
4 10     10   124 use warnings;
  10         20  
  10         5823  
5              
6             sub new {
7 66     66 1 139 my $class = shift;
8 66         310 my $self = bless {}, $class;
9 66 50       237 $self->set_options(@_) if @_;
10              
11 66 100       596 if (!$self->can('log')) {
12 9         7391 require Log::Dump; Log::Dump->import;
  9         17002  
13             }
14              
15 66         2997 $self;
16             }
17              
18             sub set_options {
19 65     65 1 120 my $self = shift;
20              
21 65         131 %{ $self } = @_;
  65         441  
22              
23 65 50       496 if ($self->can('logger')) {
24 65 100 100     1000 $self->logger( $self->{verbose} || $self->{debug} || $self->{logfilter} ? 1 : 0 );
25             }
26 65 50       1059 if ($self->can('logfilter')) {
27 65 100       201 my @filters = $self->{logfilter} ? split ',', $self->{logfilter} : ();
28 65 100       208 push @filters, '!debug' unless $self->{debug};
29 65         220 $self->logfilter(@filters);
30             }
31              
32 65         1457 $self;
33             }
34              
35 16     16 1 59 sub options {}
36              
37             sub option {
38 106     106 1 312 my ($self, $name) = @_;
39              
40 106 100       1185 defined $self->{$name} ? $self->{$name} : '';
41             }
42              
43             sub run {
44 0     0 1 0 my ($self, @args) = @_;
45              
46 0         0 return;
47             }
48              
49             sub run_directly {
50 9     9 1 139013 my $self = shift;
51 9   33     54 my $class = ref $self || $self;
52 9         1494 require CLI::Dispatch;
53 9         48 CLI::Dispatch->run_directly($class);
54             }
55              
56             sub usage {
57 0     0 1   my ($self, $no_print) = @_;
58              
59 0           my $class = ref $self;
60 0           $class =~ s{::}{/}g;
61 0           $class .= '.pm';
62              
63 0 0 0       my $file = $INC{$class} || $0 or return;
64 0           my $content = do { local $/; open my $fh, '<', $file; <$fh> };
  0            
  0            
  0            
65              
66 0           require CLI::Dispatch::Help;
67 0           my $help = CLI::Dispatch::Help->new(%$self);
68              
69 0           my $pod = $help->_parse_pod($content);
70 0           $pod = $help->extract_pod_body($pod);
71              
72 0           $pod =~ /^(\S+\s+.+?)\n(?=\S)/s; # extract first paragraph
73 0   0       $help->output( $1 || '', $no_print );
74             }
75              
76             1;
77              
78             __END__