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