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