File Coverage

lib/Serge/Sync/Plugin/TranslationService/weblate.pm
Criterion Covered Total %
statement 119 149 79.8
branch 19 42 45.2
condition 2 6 33.3
subroutine 21 25 84.0
pod 0 13 0.0
total 161 235 68.5


line stmt bran cond sub pod time code
1             # ABSTRACT: Weblate (https://weblate.org/) synchronization plugin for Serge
2              
3             package Serge::Sync::Plugin::TranslationService::weblate;
4 1     1   12914 use parent Serge::Sync::Plugin::Base::TranslationService, Serge::Interface::SysCmdRunner;
  1         2  
  1         6  
5              
6 1     1   1849 use strict;
  1         3  
  1         19  
7              
8 1     1   481 use File::chdir;
  1         1910  
  1         110  
9 1     1   7 use File::Find qw(find);
  1         2  
  1         44  
10 1     1   5 use File::Spec::Functions qw(catfile abs2rel);
  1         3  
  1         43  
11 1     1   6 use JSON -support_by_pp; # -support_by_pp is used to make Perl on Mac happy
  1         2  
  1         7  
12 1     1   112 use Serge::Util qw(subst_macros);
  1         3  
  1         85  
13 1     1   482 use version;
  1         1932  
  1         8  
14 1     1   77 use Scalar::Util qw(reftype);
  1         3  
  1         49  
15 1     1   6 use File::Path qw(make_path);
  1         2  
  1         48  
16 1     1   6 use File::Basename;
  1         2  
  1         1581  
17              
18             our $VERSION = qv('0.900.2');
19              
20             sub name {
21 2     2 0 21914 return 'Weblate translation software (https://weblate.org/) synchronization plugin';
22             }
23              
24             sub init {
25 2     2 0 26 my $self = shift;
26              
27 2         19 $self->SUPER::init(@_);
28              
29 2         12 $self->{optimizations} = 1; # set to undef to disable optimizations
30              
31 2         13 $self->merge_schema({
32             root_directory => 'STRING',
33             project => 'STRING',
34             config_file => 'STRING',
35             languages => 'ARRAY'
36             });
37             }
38              
39             sub validate_data {
40 2     2 0 1815 my ($self) = @_;
41              
42 2         9 $self->SUPER::validate_data;
43              
44 2         771 $self->{data}->{root_directory} = subst_macros($self->{data}->{root_directory});
45 2         63 $self->{data}->{project} = subst_macros($self->{data}->{project});
46 2         56 $self->{data}->{config_file} = subst_macros($self->{data}->{config_file});
47 2         52 $self->{data}->{languages} = subst_macros($self->{data}->{languages});
48              
49 2 100       53 die "'root_directory', which is set to '$self->{data}->{root_directory}', does not point to a valid folder." unless -d $self->{data}->{root_directory};
50 1 50       31 die "'config_file' not defined" unless defined $self->{data}->{config_file};
51 1 50       11 die "'config_file', which is set to '$self->{data}->{config_file}', does not point to a valid file.\n" unless -f $self->{data}->{config_file};
52 1 50       24 die "'project' not defined" unless defined $self->{data}->{project};
53              
54 1 50 33     10 if (!exists $self->{data}->{languages} or scalar(@{$self->{data}->{languages}}) == 0) {
  1         9  
55 0         0 die "the list of destination languages is empty";
56             }
57             }
58              
59             sub pull_ts {
60 1     1 0 459 my ($self, $langs) = @_;
61              
62 1         3 my $langs_to_push = $self->get_all_langs($langs);
63 1         3 my %files = $self->translation_files($langs_to_push);
64              
65 1         6 foreach my $key (sort keys %files) {
66 2         4 my $file = $files{$key};
67 2         14 my $full_path = catfile($self->{data}->{root_directory}, $file);
68              
69 2         50 my ($file_name,$folder_path,$file_suffix) = fileparse($full_path);
70              
71 2 50       40 if (!(-d $folder_path)) {
72 0         0 make_path($folder_path);
73             }
74              
75 2         12 my $cli_return = $self->run_weblate_cli('download --output "'.$file.'" '.$key, 0);
76              
77 2 50       8 if ($cli_return != 0) {
78 0         0 return $cli_return;
79             }
80             }
81              
82 1         6 return 0;
83             }
84              
85             sub push_ts {
86 1     1 0 826 my ($self, $langs) = @_;
87              
88 1         4 my $langs_to_push = $self->get_all_langs($langs);
89 1         4 my %files = $self->translation_files($langs_to_push);
90              
91 1         5 foreach my $key (sort keys %files) {
92 2         5 my $file = $files{$key};
93 2         14 my $full_path = catfile($self->{data}->{root_directory}, $file);
94              
95 2 50       53 if (-f $full_path) {
96 2         9 my $command = 'upload --overwrite --input "' . $file . '"';
97 2         5 $command .= ' --method replace';
98 2 50       11 if ($self->{data}->{fuzzy}) {
99 0         0 $command .= ' --fuzzy '.$self->{data}->{fuzzy};
100             }
101 2         17 $command .= ' '.$key;
102              
103 2         6 my $cli_return = $self->run_weblate_cli($command, 0);
104              
105 2 50       8 if ($cli_return != 0) {
106 0         0 return $cli_return;
107             }
108             }
109             }
110              
111 1         5 return 0;
112             }
113              
114             sub translation_files {
115 2     2 0 5 my ($self, $langs) = @_;
116              
117 2         6 my $json_components = $self->run_weblate_cli('--format json list-components '.$self->{data}->{project}, 1);
118              
119 2         8 my $json_components_tree = $self->parse_json($json_components);
120 2         6 my $json_components_list = $self->parse_list($json_components_tree);
121 2         4 my @components = map { $_->{slug} } @$json_components_list;
  2         8  
122              
123 2         5 my %translations = ();
124              
125 2         4 my %langs_hash = map { $_ => 1 } @$langs;
  4         12  
126              
127 2         5 foreach my $component (@components) {
128 2         10 my $json_translations = $self->run_weblate_cli('--format json list-translations '.$self->{data}->{project}.'/'.$component, 1);
129              
130 2         7 my $json_translations_tree = $self->parse_json($json_translations);
131 2         8 my $json_translations_list = $self->parse_list($json_translations_tree);
132              
133 2         5 foreach my $translation (@$json_translations_list) {
134 12         48 my $language = $translation->{language}->{code};
135 12         22 my $filename = $translation->{filename};
136 12         22 my $language_code = $translation->{language_code};
137              
138 12 100       75 if (exists $langs_hash{$language_code}) {
139 4         16 $translations{$self->{data}->{project}.'/'.$component.'/'.$language} = $filename;
140             }
141             }
142             }
143              
144 2         20 return %translations;
145             }
146              
147             sub get_all_langs {
148 2     2 0 5 my ($self, $langs) = @_;
149              
150 2 50       7 if (!$langs) {
151 2         12 $langs = $self->{data}->{languages};
152             }
153              
154 2         17 my @all_langs = ();
155              
156 2         6 push @all_langs, @$langs;
157              
158 2         6 return \@all_langs;
159             }
160              
161             sub run_weblate_cli {
162 8     8 0 46 my ($self, $action, $capture) = @_;
163              
164 8         14 my $cli_return = 0;
165              
166 8         31 my $command = 'wlc --config '.$self->{data}->{config_file}.' '.$action;
167              
168 8         221 print "Running $action ...\n";
169              
170 8         66 my $json_response = $self->run_in($self->{data}->{root_directory}, $command, 1);
171              
172 8 100       1246 if ($capture) {
173 4         12 return $json_response;
174             }
175              
176 4 50       20 if ($json_response == '') {
177 4         12 return 0;
178             }
179              
180 0         0 return $self->parse_result($json_response);
181             }
182              
183             sub parse_result {
184 0     0 0 0 my ($self, $json_response) = @_;
185              
186 0         0 my $json_tree = $self->parse_json($json_response);
187              
188 0 0       0 if (reftype($json_tree) == 'ARRAY') {
189 0         0 return 0;
190             }
191              
192 0         0 my $result = $json_tree->{result};
193              
194 0 0       0 if ($result == 'true') {
195 0         0 return 0;
196             }
197              
198 0         0 return 1;
199             }
200              
201             sub parse_list {
202 4     4 0 8 my ($self, $json_tree) = @_;
203              
204 4 50       23 if (reftype($json_tree) == 'ARRAY') {
205 4         12 return $json_tree;
206             }
207              
208 0         0 return $json_tree->{results};
209             }
210              
211             sub find_lang_files {
212 0     0 0 0 my ($self, $directory) = @_;
213              
214 0         0 my @files = ();
215              
216             find(sub {
217 0 0   0   0 push @files, abs2rel($File::Find::name, $directory) if(-f $_);
218 0         0 }, $directory);
219              
220 0         0 return @files;
221             }
222              
223             sub parse_json {
224 4     4 0 12 my ($self, $json) = @_;
225              
226 4         8 my $tree;
227 4         7 eval {
228 4         18 ($tree) = from_json($json, {relaxed => 1});
229             };
230 4 50 33     456 if ($@ || !$tree) {
231 0         0 my $error_text = $@;
232 0 0       0 if ($error_text) {
233 0         0 $error_text =~ s/\t/ /g;
234 0         0 $error_text =~ s/^\s+//s;
235             } else {
236 0         0 $error_text = "from_json() returned empty data structure";
237             }
238              
239 0         0 die $error_text;
240             }
241              
242 4         9 return $tree;
243             }
244              
245             sub get_langs {
246 0     0 0   my ($self, $langs) = @_;
247              
248 0 0         if (!$langs) {
249 0           $langs = $self->{data}->{languages};
250             }
251              
252 0           return $langs;
253             }
254              
255             1;