File Coverage

lib/App/PRT/Command/RenameNameSpace.pm
Criterion Covered Total %
statement 53 53 100.0
branch 12 14 85.7
condition 5 6 83.3
subroutine 13 13 100.0
pod 0 5 0.0
total 83 91 91.2


line stmt bran cond sub pod time code
1             package App::PRT::Command::RenameNameSpace;
2 2     2   3260 use strict;
  2         4  
  2         61  
3 2     2   9 use warnings;
  2         4  
  2         54  
4 2     2   502 use PPI;
  2         105749  
  2         68  
5 2     2   750 use App::PRT::Command::RenameClass;
  2         5  
  2         1177  
6              
7             sub new {
8 7     7 0 23702 my ($class) = @_;
9 7         35 bless {
10             source_name_space => undef,
11             target_hname_space => undef,
12             }, $class;
13             }
14              
15             # parse arguments from CLI
16             # arguments:
17             # @arguments
18             # returns:
19             # @rest_arguments
20             sub parse_arguments {
21 2     2 0 14 my ($self, @arguments) = @_;
22              
23 2 50       9 die "source and destination class are required" unless @arguments >= 2;
24              
25 2         9 $self->register(shift @arguments => shift @arguments);
26              
27 2         6 @arguments;
28             }
29              
30              
31             # register a replacing rule
32             # arguments:
33             # $source: source name space
34             # $dest: destination name space
35             sub register {
36 6     6 0 26 my ($self, $source_name_space, $destination_name_space) = @_;
37              
38 6         20 $self->{source_name_space} = $source_name_space;
39 6         17 $self->{destination_name_space} = $destination_name_space;
40             }
41              
42             sub source_name_space {
43 17     17 0 206 my ($self) = @_;
44              
45 17         100 $self->{source_name_space};
46             }
47              
48             sub destination_name_space {
49 5     5 0 12 my ($self) = @_;
50              
51 5         16 $self->{destination_name_space};
52             }
53              
54             # refactor files
55             # argumensts:
56             # $files: [ filenames for refactoring ]
57             sub execute_files {
58 1     1   13 my ($self, $files) = @_;
59              
60 1         3 my $target_classes = $self->_collect_target_classes($files);
61              
62 1         5 my $knowns = { map { $_ => 1 } @$target_classes };
  2         7  
63              
64 1         4 for my $target_class (@$target_classes) {
65 2         21 my $rename_command = App::PRT::Command::RenameClass->new;
66 2         9 $rename_command->register($target_class => $self->_destination_class_name($target_class));
67 2         4 for my $file (@$files) {
68 15 100       331 next unless -f $file;
69 14         76 my $file_after = $rename_command->execute($file);
70 14 100 100     8333 if ($file_after && $file_after ne $file && !$knowns->{$file_after}) {
      66        
71 2         8 $knowns->{$file_after}++;
72 2         8 push @$files, $file_after;
73             }
74             }
75             }
76             }
77              
78             sub _collect_target_classes {
79 2     2   5223 my ($self, $files) = @_;
80              
81             [ grep {
82 7         1307 $_
83             } map {
84 2         4 $self->_is_target_class($_);
  10         4318  
85             } @$files ];
86             }
87              
88             sub _is_target_class {
89 10     10   20 my ($self, $file) = @_;
90              
91 10         34 my $document = PPI::Document->new($file);
92              
93             # When parse failed
94 10 50       113160 return unless $document;
95              
96 10         32 my $package = $document->find_first('PPI::Statement::Package');
97              
98 10 100       8732 return unless $package;
99              
100 7 100       29 if (index($package->namespace, $self->source_name_space) == 0) {
101 4         9 $package->namespace;
102             }
103             }
104              
105             sub _destination_class_name {
106 5     5   20 my ($self, $class_name) = @_;
107              
108 5 100       14 return unless index($class_name, $self->source_name_space) == 0;
109              
110 3         8 my $dest = $class_name;
111              
112 3         11 $self->destination_name_space . substr($class_name, length($self->source_name_space));
113             }
114              
115             1;