line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::PRT::Util::DestinationFile; |
2
|
5
|
|
|
5
|
|
1829
|
use strict; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
180
|
|
3
|
5
|
|
|
5
|
|
29
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
140
|
|
4
|
5
|
|
|
5
|
|
26
|
use Path::Class; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
1593
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub destination_file { |
8
|
21
|
|
|
21
|
0
|
23924
|
my ($source_class_name, $destination_class_name, $input_file) = @_; |
9
|
|
|
|
|
|
|
|
10
|
21
|
|
|
|
|
42
|
my @delimiters = do { |
11
|
21
|
|
|
|
|
41
|
my $pattern = $source_class_name; |
12
|
21
|
|
|
|
|
624
|
$pattern =~ s{::}{(.+)}g; |
13
|
21
|
|
|
|
|
1367
|
($input_file =~ qr/^(.*)$pattern(.*)$/); |
14
|
|
|
|
|
|
|
}; |
15
|
21
|
|
|
|
|
84
|
my $prefix = shift @delimiters; |
16
|
21
|
|
|
|
|
47
|
my $suffix = pop @delimiters; |
17
|
|
|
|
|
|
|
|
18
|
21
|
|
|
|
|
42
|
my $fallback_delimiter = $delimiters[-1]; |
19
|
21
|
|
|
|
|
106
|
my $dir = file($input_file)->dir; |
20
|
21
|
|
|
|
|
11594
|
$dir = $dir->parent for grep { $_ eq '/' } @delimiters; |
|
21
|
|
|
|
|
122
|
|
21
|
21
|
|
|
|
|
2550
|
my $basename = $destination_class_name; |
22
|
21
|
|
|
|
|
89
|
$basename =~ s{::}{ |
23
|
23
|
|
66
|
|
|
242
|
shift @delimiters // $fallback_delimiter; |
24
|
|
|
|
|
|
|
}ge; |
25
|
21
|
|
|
|
|
123
|
$dir->file("$basename$suffix")->stringify; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
1; |