File Coverage

blib/lib/Nile/Lang.pm
Criterion Covered Total %
statement 3 94 3.1
branch 0 32 0.0
condition 0 31 0.0
subroutine 1 19 5.2
pod 0 16 0.0
total 4 192 2.0


line stmt bran cond sub pod time code
1             # Copyright Infomation
2             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3             # Author : Dr. Ahmed Amin Elsheshtawy, Ph.D.
4             # Website: https://github.com/mewsoft/Nile, http://www.mewsoft.com
5             # Email : mewsoft@cpan.org, support@mewsoft.com
6             # Copyrights (c) 2014-2015 Mewsoft Corp. All rights reserved.
7             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
8             package Nile::Lang;
9              
10             our $VERSION = '0.54';
11             our $AUTHORITY = 'cpan:MEWSOFT';
12              
13             =pod
14              
15             =encoding utf8
16              
17             =head1 NAME
18              
19             Nile::Lang - Language file manager.
20              
21             =head1 SYNOPSIS
22            
23             $lang = $self->app->lang;
24            
25             # load language file from the current active or default language, file extension is xml.
26             $lang->load("general");
27              
28             # load and append another language file
29             $lang->load("accounts");
30            
31             # load language file of specific language.
32             $lang->load($file, $lang);
33              
34             # get language variables from the active langauge
35             say $lang->get("site_name");
36             say $lang->get("first_name");
37             say $lang->get("last_name");
38            
39             # get language variables of specific installed language.
40             say $lang->get("site_name", 'en-US');
41              
42             # automatic getter support
43             say $lang->email; # same as $lang->get('email');
44              
45             # get a group of language variables.
46             @text = $lang->list(@names);
47              
48             # set language variables.
49             $lang->set("email_label", 'Email:');
50             $lang->set(%vars);
51              
52             # automatic setter support
53             $lang->email('ahmed@mewsoft.com'); # same as $lang->set('email', 'ahmed@mewsoft.com');
54              
55             =head1 DESCRIPTION
56              
57             Nile::Lang - Language file manager.
58              
59             =cut
60              
61 1     1   6 use Nile::Base;
  1         2  
  1         8  
62              
63             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64             =head2 file()
65            
66             # set output file name for saving
67             $lang->file($file);
68              
69             # get output file name
70             $file = $lang->file();
71              
72             Get and set the output language file name used when saving or updating. The default file extension is xml.
73              
74             =cut
75              
76             has 'file' => (
77             is => 'rw',
78             );
79              
80             =head2 encoding()
81            
82             # get encoding used to read/write the language files, default is 'UTF-8'.
83             $encoding = $lang->encoding();
84            
85             # set encoding used to read/write the langauge files, default is 'UTF-8'.
86             $lang->encoding('UTF-8');
87              
88             Get and set encoding used to read/write the language files. The default encoding is 'UTF-8'.
89              
90             =cut
91              
92             has 'encoding' => (
93             is => 'rw',
94             default => 'UTF-8',
95             );
96              
97             has 'files' => (
98             is => 'rw',
99             isa => 'HashRef',
100             default => sub { +{} }
101             );
102             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
103             sub AUTOLOAD {
104            
105 0     0     my ($self) = shift;
106              
107 0           my ($class, $method) = our $AUTOLOAD =~ /^(.*)::(\w+)$/;
108              
109 0 0         if ($self->can($method)) {
110 0           return $self->$method(@_);
111             }
112              
113 0 0         if (@_) {
114 0           $self->{vars}->{$self->{lang}}->{$method} = $_[0];
115             }
116             else {
117 0           return $self->{vars}->{$self->{lang}}->{$method};
118             }
119             }
120             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
121             =head2 load()
122            
123             # load language file from the current active or default language, file extension is xml.
124             $lang->load("general");
125              
126             # load and append another language file
127             $lang->load("accounts");
128            
129             # load language file of specific language.
130             $lang->load($file, $lang);
131              
132             Load language files from the current active or specific language. The default file extension is xml.
133             This method can be chained C<$lang->load($file)->load($register)>;
134              
135             =cut
136              
137             sub load {
138            
139 0     0 0   my ($self, $file, $lang) = @_;
140 0           my $app = $self->app;
141              
142 0   0       $lang ||= $self->{lang} ||= $app->var->get("lang");
      0        
143              
144             # file already loaded
145 0 0         if ($self->files->{$lang}->{$file}) {
146 0           return $self;
147             }
148            
149 0           my $origfile = $file;
150              
151 0 0         $file .= ".xml" unless ($file =~ /\.xml$/i);
152              
153 0           my $filename = $app->file->catfile($app->var->get("langs_dir"), $lang, $file);
154            
155 0           my $xml = $app->xml->get_file($filename);
156              
157 0   0       $self->{vars}->{$lang} ||= +{};
158 0           $self->{vars}->{$lang} = {%{$self->{vars}->{$lang}}, %$xml};
  0            
159              
160 0           $self->file($file);
161 0           $self->files->{$lang}->{$origfile} = 1;
162              
163 0           $self;
164             }
165             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
166             =head2 add()
167            
168             # load a list of language files from the current active or default language, file extension is xml.
169             $lang->add("general", "register", "contact");
170              
171             Load a list of language files from the current active or specific language. The default file extension is xml.
172             This method can be chained C<$lang->load($file, $lang)->add(@files)>;
173              
174             =cut
175              
176             sub add {
177 0     0 0   my ($self, @files) = @_;
178 0           $self->load($_) for @files;
179 0           $self;
180             }
181             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
182             =head2 reload()
183            
184             # reload a list of language files from the current active or default language, file extension is xml.
185             $lang->reload("general", "register");
186              
187             Reload a list of language files from the current active or specific language. The default file extension is xml.
188             This method can be chained.
189              
190             =cut
191              
192             sub reload {
193 0     0 0   my ($self, @files) = @_;
194 0           foreach (@files) {
195 0           delete $self->files->{$self->lang}->{$_};
196 0           $self->load($_);
197             }
198 0           $self;
199             }
200             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
201             =head2 lang()
202            
203             # get active language for the language object.
204             $lang = $lang->lang();
205              
206             # set active language for the language object.
207             $lang->lang("en-US");
208            
209             Get and set active language used when loading or writing the language files.
210              
211             =cut
212              
213             sub lang {
214 0     0 0   my ($self, $lang) = @_;
215 0 0         $self->{lang} = $lang if ($lang);
216 0   0       $self->{lang} ||= $self->app->var->get("lang");
217 0           return $self->{lang};
218             }
219             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
220             =head2 clear()
221            
222             # clear all loaded language data.
223             $lang = $lang->clear();
224              
225             # clear all loaded language data of sepcific language.
226             $lang->clear("en-US");
227            
228             Clear all loaded language data or sepcific language or all languages. This does not delete the data from files.
229              
230             =cut
231              
232             sub clear {
233 0     0 0   my ($self, $lang) = @_;
234 0 0         ($lang)? $self->{vars}->{$lang} = +{} : $self->{vars} = +{};
235 0           $self;
236             }
237             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
238             =head2 vars()
239            
240             # get all loaded language data as hash or hash ref.
241             %data = $lang->vars();
242             $data_ref = $lang->vars();
243              
244             # get all loaded language data of sepcific language as hash or hash ref.
245             %data = $lang->vars("en-US");
246             $data_ref = $lang->vars("en-US");
247            
248             Returns all loaded language data as a hash or hash reference of sepcific language or all languages.
249              
250             =cut
251              
252             sub vars {
253 0     0 0   my ($self, $lang) = @_;
254 0 0         if ($lang) {
255 0 0         return wantarray? %{$self->{vars}->{$lang}} : $self->{vars}->{$lang};
  0            
256             }
257             else {
258 0 0         return wantarray? %{$self->{vars}} : $self->{vars};
  0            
259             }
260             }
261             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262             =head2 get()
263            
264             # get language variables from the active langauge
265             say $lang->get("site_name");
266             say $lang->get("first_name");
267             say $lang->get("last_name");
268            
269             # get language variables of specific installed language.
270             say $lang->get("site_name", 'en-US');
271              
272             # automatic getter support
273             say $lang->email; # same as $lang->get('email');
274              
275             Returns language variables from the active or specific installed language.
276              
277             =cut
278              
279             sub get {
280 0     0 0   my ($self, $name, $lang) = @_;
281 0   0       $lang ||= $self->{lang} ||= $self->app->var->get("lang");
      0        
282 0           $self->{vars}->{$lang}->{$name};
283             }
284             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
285             =head2 set()
286            
287             # set language variables.
288             $lang->set("email_label", 'Email:');
289             $lang->set(%vars);
290              
291             # automatic setter support
292             $lang->email('ahmed@mewsoft.com'); # same as $lang->set('email', 'ahmed@mewsoft.com');
293              
294             Set language variables of the active language.
295              
296             =cut
297              
298             sub set {
299 0     0 0   my ($self, %vars) = @_;
300 0           map {$self->{vars}->{$self->{lang}}->{$_} = $vars{$_}} keys %vars;
  0            
301 0           $self;
302             }
303             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
304             =head2 list()
305            
306             # get a list of language variables.
307             @text = $lang->list(@names);
308              
309             Set a list of language variables from the active language.
310              
311             =cut
312              
313             sub list {
314 0     0 0   my ($self, @n) = @_;
315 0           @{$self->{vars}->{$self->{lang}}}{@n};
  0            
316             }
317             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
318             =head2 keys()
319            
320             # returns all language variables names.
321             @names = $lang->keys($);
322              
323             Returns all language variables names.
324              
325             =cut
326              
327             sub keys {
328 0     0 0   my ($self) = @_;
329 0           (keys %{$self->{vars}->{$self->{lang}}});
  0            
330             }
331             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
332             =head2 exists()
333            
334             # check if a langugage variable exist or not.
335             $found = $lang->exists($name);
336              
337             Check if a langugage variable exist or not.
338              
339             =cut
340              
341             sub exists {
342 0     0 0   my ($self, $name) = @_;
343 0           exists $self->{vars}->{$self->{lang}}->{$name};
344             }
345             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
346             =head2 delete()
347            
348             # delete langugage variables.
349             $lang->delete(@names);
350              
351             Delete a list of language variables.
352              
353             =cut
354              
355             sub delete {
356 0     0 0   my ($self, @n) = @_;
357 0           delete $self->{vars}->{$self->{lang}}->{$_} for @n;
358             }
359             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
360             =head2 get_file()
361            
362             # returns language file data from the active or default language, default file extension is xml.
363             %data = $lang->get_file("contacts");
364             $data_ref = $lang->get_file("contacts");
365              
366             # returns language file data from specific language, default file extension is xml.
367             %data = $lang->get_file("contacts", "en-US");
368             $data_ref = $lang->get_file("contacts", "en-US");
369              
370             Returns language file data as a hash or hash reference from the active or specific language. The default file extension is xml.
371              
372             =cut
373              
374             sub get_file {
375            
376 0     0 0   my ($self, $file, $lang) = @_;
377 0           my $app = $self->app;
378              
379 0 0         $file .= ".xml" unless ($file =~ /\.xml$/i);
380 0   0       $lang ||= $self->{lang} ||= $app->var->get("lang");
      0        
381              
382 0           my $filename = $app->file->catfile($app->var->get("langs_dir"), $lang, $file);
383              
384 0           my $xml = $app->xml->get_file($filename);
385            
386 0 0         return wantarray? %{$xml} : $xml;
  0            
387             }
388             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
389             =head2 save()
390            
391             # write the output file.
392             $lang->save($file);
393              
394             Save changes to the output file. If no file name it will update the loaded file name.
395              
396             =cut
397              
398             sub save {
399 0     0 0   my ($self, $file) = @_;
400 0           my $app = $self->app;
401 0   0       $file ||= $self->file;
402 0 0         $file .= ".xml" unless ($file =~ /\.xml$/i);
403 0           my $filename = $app->file->catfile($app->var->get("langs_dir"), $self->{lang}, $file);
404 0           $app->xml->writefile($filename, $self->{vars}->{$self->{lang}}, $self->encoding);
405 0           $self;
406             }
407             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
408             =head2 translate()
409            
410             # scan and replace the language variables $passes times in language $lang
411             $content = $lang->translate($content, $lang, $passes)
412            
413             # pass content by ref for better speed
414             $lang->translate(\$content, $lang, $passes)
415            
416             # use current language and default passes
417             $content = $lang->translate($content);
418             $lang->translate(\$content);
419              
420             # use specific language and passes
421             $lang->translate($content, "en-US", 3);
422              
423             Translate language variables inside contents to their language values. It scans the content for the langauge variables
424             surrounded by the curly braces B<{var_name}> and replaces them with their values from the loaded language files.
425              
426             =cut
427              
428             sub translate {
429            
430 0     0 0   my ($self, $text, $lang, $passes) = @_;
431            
432 0 0         my $content = ref($text) ? $text: \$text;
433            
434             # at least should be 2 passes for variables inside variables
435 0           $passes += 0;
436 0   0       $passes ||= 2;
437            
438 0 0 0       if (!defined ($lang) and $lang ne "") {
439 0           $lang = $self->{lang};
440             }
441            
442 0           my $vars = $self->{vars}->{$lang};
443              
444 0           while ($passes--) {
445             # If you knew ahead of time the string was a word character for example you might try \w{1,} instead
446             # of .+? to squeeze a tiny bit more speed out of this
447 0 0         $$content =~ s/\{(.+?)\}/exists $vars->{$1} ? $vars->{$1} : "\{$1\}"/gex;
  0            
448             #$self->{content} =~ s{\{(.+?)\}(?(?{exists $vars->{$1}})(*SKIP)(*FAIL))}{$vars->{$1}}gx; # Perl 5.10, slower 11%
449             }
450              
451 0 0         if (!ref($text)) {
452 0           return $$content;
453             }
454              
455 0           $self;
456             }
457             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
458             =head2 translate_file()
459            
460             $content = $lang->translate_file($file, $lang, $passes);
461            
462             # use current langauge and default passes
463             $content = $lang->translate_file($file);
464             $content = $lang->translate_file($file, $lang);
465              
466             Loads and translates a file. The $file argument must be the full system file path.
467              
468             =cut
469              
470             sub translate_file {
471 0     0 0   my ($self, $file, $lang, $passes) = @_;
472 0           return $self->translate($self->app->file->get($file), $lang, $passes);
473             }
474             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
475 0     0     sub DESTROY {
476             }
477             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
478              
479             =pod
480              
481             =head1 Bugs
482              
483             This project is available on github at L<https://github.com/mewsoft/Nile>.
484              
485             =head1 HOMEPAGE
486              
487             Please visit the project's homepage at L<https://metacpan.org/release/Nile>.
488              
489             =head1 SOURCE
490              
491             Source repository is at L<https://github.com/mewsoft/Nile>.
492              
493             =head1 SEE ALSO
494              
495             See L<Nile> for details about the complete framework.
496              
497             =head1 AUTHOR
498              
499             Ahmed Amin Elsheshtawy, احمد امين الششتاوى <mewsoft@cpan.org>
500             Website: http://www.mewsoft.com
501              
502             =head1 COPYRIGHT AND LICENSE
503              
504             Copyright (C) 2014-2015 by Dr. Ahmed Amin Elsheshtawy احمد امين الششتاوى mewsoft@cpan.org, support@mewsoft.com,
505             L<https://github.com/mewsoft/Nile>, L<http://www.mewsoft.com>
506              
507             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
508              
509             =cut
510              
511             1;