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   2091 use strict;
  2         2  
  2         51  
3 2     2   5 use warnings;
  2         3  
  2         49  
4 2     2   475 use PPI;
  2         85298  
  2         53  
5 2     2   558 use App::PRT::Command::RenameClass;
  2         4  
  2         706  
6              
7             sub new {
8 7     7 0 12856 my ($class) = @_;
9 7         32 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 10 my ($self, @arguments) = @_;
22              
23 2 50       8 die "source and destination class are required" unless @arguments >= 2;
24              
25 2         7 $self->register(shift @arguments => shift @arguments);
26              
27 2         5 @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 21 my ($self, $source_name_space, $destination_name_space) = @_;
37              
38 6         14 $self->{source_name_space} = $source_name_space;
39 6         14 $self->{destination_name_space} = $destination_name_space;
40             }
41              
42             sub source_name_space {
43 17     17 0 148 my ($self) = @_;
44              
45 17         96 $self->{source_name_space};
46             }
47              
48             sub destination_name_space {
49 5     5 0 7 my ($self) = @_;
50              
51 5         15 $self->{destination_name_space};
52             }
53              
54             # refactor files
55             # argumensts:
56             # $files: [ filenames for refactoring ]
57             sub execute_files {
58 1     1   10 my ($self, $files) = @_;
59              
60 1         5 my $target_classes = $self->_collect_target_classes($files);
61              
62 1         3 my $knowns = { map { $_ => 1 } @$target_classes };
  2         5  
63              
64 1         4 for my $target_class (@$target_classes) {
65 2         18 my $rename_command = App::PRT::Command::RenameClass->new;
66 2         9 $rename_command->register($target_class => $self->_destination_class_name($target_class));
67 2         3 for my $file (@$files) {
68 15 100       506 next unless -f $file;
69 14         44 my $file_after = $rename_command->execute($file);
70 14 100 100     5344 if ($file_after && $file_after ne $file && !$knowns->{$file_after}) {
      66        
71 2         5 $knowns->{$file_after}++;
72 2         7 push @$files, $file_after;
73             }
74             }
75             }
76             }
77              
78             sub _collect_target_classes {
79 2     2   3541 my ($self, $files) = @_;
80              
81             [ grep {
82 7         730 $_
83             } map {
84 2         7 $self->_is_target_class($_);
  10         2578  
85             } @$files ];
86             }
87              
88             sub _is_target_class {
89 10     10   15 my ($self, $file) = @_;
90              
91 10         45 my $document = PPI::Document->new($file);
92              
93             # When parse failed
94 10 50       57172 return unless $document;
95              
96 10         35 my $package = $document->find_first('PPI::Statement::Package');
97              
98 10 100       6649 return unless $package;
99              
100 7 100       27 if (index($package->namespace, $self->source_name_space) == 0) {
101 4         10 $package->namespace;
102             }
103             }
104              
105             sub _destination_class_name {
106 5     5   12 my ($self, $class_name) = @_;
107              
108 5 100       31 return unless index($class_name, $self->source_name_space) == 0;
109              
110 3         5 my $dest = $class_name;
111              
112 3         10 $self->destination_name_space . substr($class_name, length($self->source_name_space));
113             }
114              
115             1;