File Coverage

lib/Smartcat/App/Utils.pm
Criterion Covered Total %
statement 60 78 76.9
branch 7 10 70.0
condition n/a
subroutine 11 15 73.3
pod 0 9 0.0
total 78 112 69.6


line stmt bran cond sub pod time code
1             package Smartcat::App::Utils;
2              
3 3     3   740 use strict;
  3         9  
  3         92  
4 3     3   18 use warnings;
  3         5  
  3         76  
5              
6 3     3   15 use File::Basename;
  3         6  
  3         235  
7 3     3   18 use File::Spec::Functions qw(catfile splitpath splitdir);
  3         6  
  3         212  
8              
9 3         3054 use Smartcat::App::Constants qw(
10             PATH_SEPARATOR
11 3     3   1124 );
  3         6  
12             our @ISA = qw(Exporter);
13              
14             our @EXPORT = qw(
15             prepare_document_name
16             prepare_file_name
17             save_file
18             get_language_from_ts_filepath
19             get_ts_file_key
20             get_document_key
21             format_error_message
22             get_file_path
23             are_po_files_empty
24             );
25              
26             sub _get_path_items {
27 6     6   7 my ($project_workdir, $path) = @_;
28              
29 6         18 my ($project_workdir_volume, $project_workdir_dirs, $project_workdir_name) = splitpath($project_workdir);
30 6         89 my ($volume, $dirs, $name) = splitpath($path);
31              
32 6         52 my @project_workdir_dirs = grep {$_ ne ""} splitdir($project_workdir_dirs);
  20         58  
33 6 100       21 push @project_workdir_dirs, $project_workdir_name if $project_workdir_name ne "";
34              
35 6         13 my @result = grep {$_ ne ""} splitdir($dirs);
  41         78  
36 6         12 foreach (@project_workdir_dirs) {
37 18 100       31 shift @result if $_ eq $result[0];
38             }
39 6         11 push @result, $name;
40              
41 6         19 return @result;
42             }
43              
44             sub get_language_from_ts_filepath {
45 2     2 0 581 my ($project_workdir, $path) = @_;
46              
47 2         5 my @path_items = _get_path_items($project_workdir, $path);
48              
49 2         9 return shift @path_items;
50             }
51              
52              
53             sub get_ts_file_key {
54 2     2 0 5 my ($project_workdir, $path) = @_;
55              
56 2         5 my @path_items = _get_path_items($project_workdir, $path);
57              
58 2         4 my $language = shift @path_items;
59 2         5 my $filepath = join(PATH_SEPARATOR, @path_items);
60              
61 2         11 return "$filepath ($language)";
62             }
63              
64              
65             sub get_document_key {
66 0     0 0 0 my ( $name, $target_language ) = @_;
67              
68 0         0 my $key = $name;
69 0         0 $key =~ s/_($target_language)$//i;
70 0         0 return $key . ' (' . $target_language . ')';
71             }
72              
73              
74             sub prepare_document_name {
75 2     2 0 6 my ( $project_workdir, $path, $filetype, $target_language ) = @_;
76              
77 2         6 $path = join(PATH_SEPARATOR, _get_path_items($project_workdir, $path));
78 2         88 my ( $filename, $dirs, $ext ) = fileparse( $path, $filetype );
79 2         8 my @path_items = grep { $_ ne '' } splitdir($dirs);
  8         21  
80 2         3 shift @path_items;
81 2         5 push @path_items, $filename;
82 2         4 my $filepath = join(PATH_SEPARATOR, @path_items);
83              
84 2         11 return $filepath . '_' . $target_language . $ext;
85             }
86              
87              
88             sub prepare_file_name {
89 1     1 0 3 my ( $document_name, $document_target_language, $ext ) = @_;
90              
91 1         16 my $regexp = qr/_$document_target_language/;
92 1         18 $document_name =~ s/(.*)$regexp/$1/;
93              
94 1         6 return $document_name . $ext;
95             }
96              
97              
98             sub get_file_path {
99 0     0 0 0 my ( $project_workdir, $document_target_language, $document_name, $ext ) = @_;
100 0         0 my $filename =
101             prepare_file_name( $document_name, $document_target_language, $ext );
102              
103 0         0 return catfile( $project_workdir, $document_target_language, $filename );
104             }
105              
106              
107             sub format_error_message {
108 0     0 0 0 my $s = shift;
109              
110 0         0 $s = " " . $s;
111 0         0 $s =~ s/\\r//;
112 0         0 $s =~ s/\\n/\n/;
113 0         0 $s =~ s/\n/\n /;
114              
115 0         0 return $s;
116             }
117              
118              
119             sub save_file {
120 0     0 0 0 my ( $filepath, $content ) = @_;
121 0 0       0 open( my $fh, '>', $filepath ) or die "Could not open file '$filepath' $!";
122 0         0 binmode($fh);
123 0         0 print $fh $content;
124 0         0 close $fh;
125             }
126              
127              
128             sub are_po_files_empty {
129 3     3 0 6 my $filepaths = shift;
130 3         6 my $empty = 1;
131              
132 3         5 for my $filepath (@$filepaths) {
133 3 50       145 open(my $fh, $filepath) or die "Can't read $filepath: $!\n";
134 3         23 binmode($fh, ':utf8');
135 3         1355 my $text = join('', <$fh>);
136 3         46 close $fh;
137              
138             # join multi-line entries
139 3         61 $text =~ s/"\r?\n"//sg;
140              
141 3 100       28 if ($text =~ m/msgid "[^"]/s) {
142 1         3 $empty = undef;
143 1         5 last;
144             }
145             }
146 3         19 return $empty;
147             }
148              
149              
150             1;