File Coverage

lib/App/PRT/CLI.pm
Criterion Covered Total %
statement 82 82 100.0
branch 19 20 95.0
condition n/a
subroutine 19 19 100.0
pod 0 6 0.0
total 120 127 94.4


line stmt bran cond sub pod time code
1             package App::PRT::CLI;
2 1     1   1175 use strict;
  1         1  
  1         24  
3 1     1   3 use warnings;
  1         2  
  1         20  
4              
5 1     1   7 use Class::Load qw(load_class);
  1         1  
  1         39  
6 1     1   632 use Getopt::Long qw(GetOptionsFromArray);
  1         7064  
  1         4  
7 1     1   518 use IO::Interactive qw(is_interactive);
  1         560  
  1         5  
8 1     1   30 use Cwd ();
  1         1  
  1         12  
9 1     1   246 use App::PRT::Collector::FileHandle;
  1         1  
  1         23  
10 1     1   305 use App::PRT::Collector::Files;
  1         1  
  1         22  
11 1     1   242 use App::PRT::Collector::AllFiles;
  1         2  
  1         24  
12 1     1   272 use App::PRT::Collector::GitDirectory;
  1         1  
  1         429  
13              
14             sub new {
15 13     13 0 50427 my ($class) = @_;
16              
17 13         30 bless {}, $class;
18             }
19              
20             sub set_io {
21 1     1 0 5 my ($self, $stdin, $stdout) = @_;
22 1         2 $self->{input} = $stdin;
23 1         5 $self->{output} = $stdout;
24             }
25              
26             sub parse {
27 10     10 0 3612 my ($self, @args) = @_;
28              
29 10 100       31 my $command = shift @args or die 'prt ';
30              
31 9         18 my $command_class = $self->_command_name_to_command_class($command);
32              
33 9         9 eval {
34 9         20 load_class $command_class;
35             };
36              
37 9 100       903 if ($@) {
38 1         7 die "Command $command not found ($@)";
39             }
40              
41 8         27 $self->{command} = $command_class->new;
42              
43 8         21 my @rest_args = $self->{command}->parse_arguments(@args);
44              
45 8         17 my $collector = $self->_prepare_collector(@rest_args);
46 8 100       30 unless ($collector) {
47 1         9 die 'Cannot decide target files';
48             }
49 7         7 $self->{collector} = $collector;
50              
51 7         14 1;
52             }
53              
54             sub run {
55 2     2 0 195 my ($self) = @_;
56              
57 2         4 my $collector = $self->collector;
58 2         3 my $command = $self->command;
59              
60 2 100       10 if ($command->can('execute_files')) { # TODO: create a base class for command?
61 1         3 $command->execute_files($collector->collect, $self->{output});
62             } else {
63 1         2 for my $file (@{$collector->collect}) {
  1         2  
64 1         5 $command->execute($file, $self->{output});
65             }
66             }
67             }
68              
69             sub _prepare_collector {
70 8     8   10 my ($self, @args) = @_;
71              
72             # target files specified?
73 8 100       15 if (@args) {
74 3         18 return App::PRT::Collector::Files->new(@args);
75             }
76              
77             # STDIN from pipe?
78 5 100       9 if ($self->_input_is_pipe) {
79 1         14 return App::PRT::Collector::FileHandle->new($self->{input});
80             }
81              
82 4         12 my $cwd = Cwd::getcwd;
83              
84             # git directory?
85 4         44 my $git_root_directory = App::PRT::Collector::GitDirectory->find_git_root_directory($cwd);
86 4 100       24 if ($git_root_directory) {
87 1         5 return App::PRT::Collector::GitDirectory->new($git_root_directory);
88             }
89              
90             # seems perl project?
91 3         19 my $project_root_directory = App::PRT::Collector::AllFiles->find_project_root_directory($cwd);
92 3 100       33 if ($project_root_directory) {
93 2         5 return App::PRT::Collector::AllFiles->new($project_root_directory);
94             }
95              
96 1         2 return;
97             }
98              
99             # -t Filehandle is opened to a tty.
100             sub _input_is_pipe {
101 4     4   5 my ($self) = @_;
102 4 50       25 $self->{input} && ! is_interactive($self->{input});
103             }
104              
105             sub command {
106 6     6 0 20 my ($self) = @_;
107              
108 6         25 $self->{command};
109             }
110              
111             sub collector {
112 7     7 0 3105 my ($self) = @_;
113              
114 7         21 $self->{collector};
115             }
116              
117             sub _command_name_to_command_class {
118 12     12   378 my ($self, $name) = @_;
119              
120 12         30 my $command_class = join '', map { ucfirst } split '_', $name;
  23         47  
121              
122             # XXX: Super hack to fix typo
123 12 100       28 if ($command_class eq 'RenameNamespace') {
124 2         4 $command_class = 'RenameNameSpace';
125             }
126              
127 12         26 'App::PRT::Command::' . $command_class;
128             }
129              
130             1;