File Coverage

blib/lib/App/CLI/Helper.pm
Criterion Covered Total %
statement 40 42 95.2
branch 6 10 60.0
condition 4 9 44.4
subroutine 8 8 100.0
pod 3 3 100.0
total 61 72 84.7


line stmt bran cond sub pod time code
1             package App::CLI::Helper;
2              
3 2     2   14 use strict;
  2         4  
  2         61  
4 2     2   9 use warnings;
  2         3  
  2         58  
5              
6 2     2   13 use File::Basename qw( basename );
  2         4  
  2         184  
7              
8             sub import {
9 2     2   14 no strict 'refs';
  2         5  
  2         1039  
10 4     4   8 my $caller = caller;
11 4         13 for (qw(commands files prog_name)) {
12 12         23 *{ $caller . "::$_" } = *$_;
  12         136  
13             }
14             }
15              
16             =head3 commands()
17              
18             List the application commands.
19              
20             =cut
21              
22             sub commands {
23 24     24 1 625 my ( $class, $include_alias ) = @_;
24 24   66     66 my $dir = ref($class) || $class;
25              
26 24         58 $dir =~ s{::}{/}g;
27 24         65 $dir = $INC{ $dir . '.pm' };
28 24         104 $dir =~ s/\.pm$//;
29              
30 24         83 my @cmds = map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
  35         310  
  35         124  
31              
32 24 0 33     74 if ( $include_alias and ref $class and $class->can('alias') ) {
      33        
33 0         0 my %aliases = $class->alias;
34 0         0 push @cmds, $_ foreach keys %aliases;
35             }
36 24         77 my @sorted_cmds = sort @cmds;
37              
38 24         95 return @sorted_cmds;
39             }
40              
41             =head3 prog_name()
42              
43             The name of the program running your application. This will default to
44             C, but can be overridden from within your application.
45              
46             =cut
47              
48             {
49             my $default;
50              
51             sub prog_name {
52 2     2 1 5 my $self = shift;
53              
54 2 100       72 $default = basename $0 unless $default;
55 2 50       8 return $default unless ref $self;
56              
57 2 50       6 return $self->{prog_name} if defined $self->{prog_name};
58              
59 2         50 $self->{prog_name} = basename $0;
60 2         10 return $self->{prog_name};
61             }
62             }
63              
64             =head3 files()
65              
66             Return module files of subcommands of first level
67              
68             =cut
69              
70             sub files {
71 28     28 1 41 my $class = shift;
72 28 100       75 $class = ref($class) if ref($class);
73 28         56 $class =~ s{::}{/}g;
74 28         58 my $dir = $INC{ $class . '.pm' };
75 28         88 $dir =~ s/\.pm$//;
76 28         2182 my @sorted_files = sort glob("$dir/*.pm");
77              
78 28         184 return @sorted_files;
79             }
80              
81             1;