File Coverage

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


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   12160 use parent Serge::Sync::Plugin::Base::TranslationService, Serge::Interface::SysCmdRunner;
  1         2  
  1         9  
5              
6 1     1   1644 use strict;
  1         2  
  1         18  
7              
8 1     1   401 use File::chdir;
  1         1540  
  1         100  
9 1     1   7 use File::Find qw(find);
  1         2  
  1         39  
10 1     1   6 use File::Spec::Functions qw(catfile abs2rel);
  1         2  
  1         50  
11 1     1   6 use JSON -support_by_pp; # -support_by_pp is used to make Perl on Mac happy
  1         2  
  1         9  
12 1     1   103 use Serge::Util qw(subst_macros);
  1         3  
  1         68  
13 1     1   405 use version;
  1         1647  
  1         8  
14 1     1   66 use Scalar::Util qw(reftype);
  1         2  
  1         43  
15 1     1   6 use File::Path qw(make_path);
  1         2  
  1         43  
16 1     1   6 use File::Basename;
  1         2  
  1         1249  
17              
18             our $VERSION = qv('0.900.3');
19              
20             sub name {
21 5     5 0 70727 return 'Weblate translation software (https://weblate.org/) synchronization plugin';
22             }
23              
24             sub init {
25 5     5 0 57 my $self = shift;
26              
27 5         31 $self->SUPER::init(@_);
28              
29 5         34 $self->{optimizations} = 1; # set to undef to disable optimizations
30              
31 5         36 $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 5     5 0 3737 my ($self) = @_;
41              
42 5         21 $self->SUPER::validate_data;
43              
44 5         1783 $self->{data}->{root_directory} = subst_macros($self->{data}->{root_directory});
45 5         153 $self->{data}->{project} = subst_macros($self->{data}->{project});
46 5         116 $self->{data}->{config_file} = subst_macros($self->{data}->{config_file});
47 5         110 $self->{data}->{languages} = subst_macros($self->{data}->{languages});
48              
49 5 100       114 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 4 100       118 die "'config_file' not defined" unless defined $self->{data}->{config_file};
51 3 50       28 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 3 100       60 die "'project' not defined" unless defined $self->{data}->{project};
53              
54 2 50 33     19 if (!exists $self->{data}->{languages} or scalar(@{$self->{data}->{languages}}) == 0) {
  2         16  
55 0         0 die "the list of destination languages is empty";
56             }
57             }
58              
59             sub pull_ts {
60 1     1 0 469 my ($self, $langs) = @_;
61              
62 1         5 my $langs_to_push = $self->get_all_langs($langs);
63 1         5 my %files = $self->translation_files($langs_to_push);
64              
65 1         9 foreach my $key (sort keys %files) {
66 2         4 my $file = $files{$key};
67 2         13 my $full_path = catfile($self->{data}->{root_directory}, $file);
68              
69 2         41 my ($file_name,$folder_path,$file_suffix) = fileparse($full_path);
70              
71 2 50       36 if (!(-d $folder_path)) {
72 0         0 make_path($folder_path);
73             }
74              
75 2         11 my $cli_return = $self->run_weblate_cli('download --output "'.$file.'" '.$key, 0);
76              
77 2 50       6 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 694 my ($self, $langs) = @_;
87              
88 1         3 my $langs_to_push = $self->get_all_langs($langs);
89 1         4 my %files = $self->translation_files($langs_to_push);
90              
91 1         6 foreach my $key (sort keys %files) {
92 2         4 my $file = $files{$key};
93 2         11 my $full_path = catfile($self->{data}->{root_directory}, $file);
94              
95 2 50       45 if (-f $full_path) {
96 2         8 my $command = 'upload --overwrite --input "' . $file . '"';
97 2         4 $command .= ' --method replace';
98 2 50       9 if ($self->{data}->{fuzzy}) {
99 0         0 $command .= ' --fuzzy '.$self->{data}->{fuzzy};
100             }
101 2         15 $command .= ' '.$key;
102              
103 2         5 my $cli_return = $self->run_weblate_cli($command, 0);
104              
105 2 50       7 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 6 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         7 my $json_components_list = $self->parse_list($json_components_tree);
121 2         5 my @components = map { $_->{slug} } @$json_components_list;
  2         7  
122              
123 2         4 my %translations = ();
124              
125 2         4 my %langs_hash = map { $_ => 1 } @$langs;
  4         11  
126              
127 2         6 foreach my $component (@components) {
128 2         9 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         6 my $json_translations_list = $self->parse_list($json_translations_tree);
132              
133 2         6 foreach my $translation (@$json_translations_list) {
134 12         43 my $language = $translation->{language}->{code};
135 12         20 my $filename = $translation->{filename};
136 12         15 my $language_code = $translation->{language_code};
137              
138 12 100       66 if (exists $langs_hash{$language_code}) {
139 4         14 $translations{$self->{data}->{project}.'/'.$component.'/'.$language} = $filename;
140             }
141             }
142             }
143              
144 2         17 return %translations;
145             }
146              
147             sub get_all_langs {
148 2     2 0 6 my ($self, $langs) = @_;
149              
150 2 50       9 if (!$langs) {
151 2         9 $langs = $self->{data}->{languages};
152             }
153              
154 2         15 my @all_langs = ();
155              
156 2         5 push @all_langs, @$langs;
157              
158 2         4 return \@all_langs;
159             }
160              
161             sub run_weblate_cli {
162 8     8 0 40 my ($self, $action, $capture) = @_;
163              
164 8         15 my $cli_return = 0;
165              
166 8         23 my $command = 'wlc --config '.$self->{data}->{config_file}.' '.$action;
167              
168 8         185 print "Running $action ...\n";
169              
170 8         64 my $json_response = $self->run_in($self->{data}->{root_directory}, $command, 1);
171              
172 8 100       940 if ($capture) {
173 4         11 return $json_response;
174             }
175              
176 4 50       16 if ($json_response == '') {
177 4         10 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 9 my ($self, $json_tree) = @_;
203              
204 4 50       20 if (reftype($json_tree) == 'ARRAY') {
205 4         10 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 11 my ($self, $json) = @_;
225              
226 4         7 my $tree;
227 4         5 eval {
228 4         17 ($tree) = from_json($json, {relaxed => 1});
229             };
230 4 50 33     384 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;