File Coverage

lib/Serge/Sync/Plugin/TranslationService/weblate.pm
Criterion Covered Total %
statement 116 146 79.4
branch 21 42 50.0
condition 2 6 33.3
subroutine 20 24 83.3
pod 0 13 0.0
total 159 231 68.8


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