File Coverage

blib/lib/Locale/Maketext/From/Strings.pm
Criterion Covered Total %
statement 118 125 94.4
branch 31 58 53.4
condition 14 25 56.0
subroutine 21 22 95.4
pod 8 8 100.0
total 192 238 80.6


line stmt bran cond sub pod time code
1             package Locale::Maketext::From::Strings;
2              
3             =head1 NAME
4              
5             Locale::Maketext::From::Strings - Parse Apple .strings files
6              
7             =head1 VERSION
8              
9             0.03
10              
11             =head1 SYNOPSIS
12              
13             use Locale::Maketext::From::Strings;
14              
15             my $strings = Locale::Maketext::From::Strings->new(
16             path => '/path/to/strings',
17             namespace => 'MyApp::I18N',
18             out_dir => 'lib',
19             );
20              
21             $strings->load; # in memory
22             $strings->generate; # to disk
23              
24             =head1 DESCRIPTION
25              
26             This module will parse C<.strings> file used in the Apple world and generate
27             in memory perl-packages used by the L module.
28              
29             =head2 Formatting rules
30              
31             This module can parse most of the formatting mentioned here:
32             L.
33              
34             =over 4
35              
36             =item *
37              
38             Key-value pairs are delimited with the equal character (=), and terminated by
39             a semicolon (;).
40              
41             =item *
42              
43             Keys and values are surrounded by double quotes (").
44              
45             =item *
46              
47             Place-holders look can be: %.2f, %d, %1$s:
48              
49             qr{\%[\d|\.]*\$*\d*[dsf]\b}
50              
51             =item *
52              
53             Comments start at the beginning of the line and span the whole line.
54              
55             =item *
56              
57             Multi-line comments are enclosed in /* */.
58              
59             =item *
60              
61             Single-line comments start with double slashes (//).
62              
63             =item *
64              
65             The specification says it expect UTF-16LE encoding by default, but this
66             module expect UTF-8 instead.
67              
68             NOTE! This might change in future release. Pass L to constructor
69             if you want to be sure about the value.
70              
71             =back
72              
73             =head2 Example file
74              
75             This could be the content of "i18n/en.strings":
76              
77             /* comments in .strings files
78             can be multi line,
79             single line */
80             // or combination of the two
81             "hello_user" = "Hello %1$s";
82              
83             "Sample data" = "sample %s %d %.3f data";
84              
85             // keys and values can be spread to multiple lines
86             "welcome_message" = "Welcome back,
87             we have missed you";
88              
89             TIP! Adding the default value on the left side (instead of hello_user and
90             welcome_message) works better with L since it will use that
91             as fallback if translation is missing.
92              
93             =cut
94              
95 4     4   28595 use strict;
  4         8  
  4         128  
96 4     4   18 use warnings;
  4         5  
  4         134  
97 4     4   2594 use File::Spec::Functions qw( catfile splitdir );
  4         3024  
  4         297  
98 4     4   3407 use Data::Dumper ();
  4         40982  
  4         208  
99 4 50   4   31 use constant DEBUG => $ENV{MAKETEXT_FROM_STRINGS_DEBUG} ? 1 : 0;
  4         6  
  4         7268  
100              
101             our $VERSION = '0.03';
102              
103             =head1 ATTRIBUTES
104              
105             =head2 encoding
106              
107             Holds the encoding used when reading the C<.strings> files. Defaults to
108             "UTF-8".
109              
110             =cut
111              
112 0   0 0 1 0 sub encoding { shift->{encoding} ||= 'UTF-8' }
113              
114             =head2 namespace
115              
116             Package name of where to L or L code into. Default to the
117             caller namespace.
118              
119             =cut
120              
121             sub namespace {
122 13     13 1 44 my $self = shift;
123 13   66     69 $self->{namespace} ||= do {
124 2         14 my $caller = (caller 0)[0];
125 2 100       18 $caller = (caller 1) if $caller->isa(__PACKAGE__);
126 2         16 $caller .= '::I18N';
127             };
128             }
129              
130             =head2 out_dir
131              
132             Directory to where files should be written to. Defaults to "lib".
133              
134             =cut
135              
136 2   50 2 1 14 sub out_dir { shift->{out_dir} ||= 'lib' }
137              
138             =head2 path
139              
140             Path to ".strings" files. Defaults to "i18n".
141              
142             =cut
143              
144 4   100 4 1 18 sub path { shift->{path} ||= 'i18n' }
145              
146             sub _namespace_dir {
147 4     4   8 my $self = shift;
148 4   66     23 $self->{_namespace_dir} ||= do {
149 3         8 my $dir = $self->namespace;
150 3         14 $dir =~ s!::!/!g;
151 3         12 $dir;
152             };
153             }
154              
155             =head1 METHODS
156              
157             =head2 new
158              
159             $self = Locale::Maketext::From::Strings->new(%attributes);
160             $self = Locale::Maketext::From::Strings->new($attributes);
161              
162             Object constructor.
163              
164             =cut
165              
166             sub new {
167 4     4 1 138 my $class = shift;
168 4 50 33     70 bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
  0 100       0  
169             }
170              
171             =head2 generate
172              
173             Locale::Maketext::From::Strings->generate($namespace);
174             $self->generate;
175              
176             This method will write the I18N code to disk. Use this when the L time
177             goes up.
178              
179             NOTE! This method does not check for existing files - they will be overwritte
180             without warning.
181              
182             Example one-liners:
183              
184             $ perl -MLocale::Maketext::From::Strings=generate -e1 MyApp::I18N
185             $ perl -Ilib -E'say +(require MyApp::I18N)->get_handle(shift)->maketext(@ARGV);' en "some key" ...
186              
187             =cut
188              
189             sub generate {
190 1     1 1 3 my $self = shift;
191 1         2 my($code, $namespace_dir, $path);
192              
193 1 50       5 unless(ref $self) {
194 0 0       0 $self = bless @_ ? @_ > 1 ? {@_} : !ref $_[0] ? { namespace => shift } : {%{$_[0]}} : {}, $self;
  0 0       0  
    0          
195             }
196              
197 1         4 $path = $self->path;
198 1         4 $namespace_dir = catfile $self->out_dir, $self->_namespace_dir;
199              
200 1         5 _mkdir($namespace_dir);
201 1 50       25 _spurt($self->_namespace_code, $namespace_dir .'.pm') unless -s $namespace_dir .'.pm';
202 1 50       45 opendir(my $DH, $path) or die "opendir $path: $!";
203              
204 1         16 for my $file (grep { /\.strings$/ } readdir $DH) {
  3         41  
205 1         2 my $language = $file;
206 1         2 my($code, $kv);
207              
208 1 50       7 $language =~ s/\.strings$// or next;
209 1         5 $code = $self->_package_code($language);
210 1         10 $kv = $self->parse(catfile $path, $file);
211              
212 1         5 local $Data::Dumper::Indent = 1;
213 1         3 local $Data::Dumper::Sortkeys = 1;
214 1         4 local $Data::Dumper::Terse = 1;
215 1         7 $kv = Data::Dumper::Dumper($kv);
216 1         143 $kv =~ s!^\{!our %Lexicon = (!;
217 1         7 $kv =~ s!\}$!);!;
218 1         6 substr $code, -3, -3, $kv;
219 1         13 _spurt($code, catfile $namespace_dir, "$language.pm");
220             }
221              
222 1         26 return $self;
223             }
224              
225             =head2 load
226              
227             Locale::Maketext::From::Strings->load($path);
228             $self->load;
229              
230             Will parse C files from L and generage in-memory
231             packages in the given L.
232              
233             Example L app:
234              
235             package MyApp;
236             use Locale::Maketext::From::Strings;
237             use base 'Mojolicious';
238              
239             sub startup {
240             my $self = sihft;
241             my $default_lang = 'en';
242              
243             Locale::Maketext::From::Strings->load($self->home->rel_dir('i18n'));
244              
245             $self->helper(l => sub {
246             my $c = shift;
247             $c->stash->{i18n} ||= MyApp::I18N->get_handle($c->session('lang'), $default_lang);
248             $c->stash->{i18n}->maketext(@_);
249             });
250             }
251              
252             See also L.
253              
254             =cut
255              
256             sub load {
257 2     2 1 102 my $self = shift;
258 2         4 my($namespace, $namespace_dir, $path);
259              
260 2 100       8 unless(ref $self) {
261 1 0       4 $self = bless @_ ? @_ > 1 ? {@_} : !ref $_[0] ? { path => shift } : {%{$_[0]}} : {}, $self;
  0 0       0  
    50          
262             }
263              
264 2         7 $namespace = $self->namespace;
265 2         8 $namespace_dir = $self->_namespace_dir;
266 2         7 $path = $self->path;
267              
268 2 50   2   8 eval $self->_namespace_code or die $@;
  2         2  
  2         9401  
  2         6  
269 2         13 $INC{"$namespace_dir.pm"} = 'GENERATED';
270 2 50       98 opendir(my $DH, $path) or die "opendir $path: $!";
271              
272 2         44 for my $file (grep { /\.strings$/ } readdir $DH) {
  6         26  
273 2         5 my $language = $file;
274 2 50       15 $language =~ s/\.strings$// or next;
275              
276 2 50   2   15 eval $self->_package_code($language) or die $@;
  2         20  
  2         166  
  2         13  
277 2         135 $self->parse(catfile($path, $file), eval "\\%$namespace\::$language\::Lexicon");
278 2         16 $INC{"$namespace_dir/$language.pm"} = 'GENERATED';
279             }
280              
281 2         42 return $self;
282             }
283              
284             =head2 parse
285              
286             $data = $self->parse($file);
287              
288             Will parse C<$file> and store the key value pairs in C<$data>.
289              
290             =cut
291              
292             sub parse {
293 4     4 1 8 my($self, $file, $data) = @_;
294 4   50     32 my $encoding = $self->{encoding} || 'UTF-8';
295 4         9 my $buf = '';
296              
297 4   100     21 $data ||= {};
298 4 50   4   24 open my $FH, "<:encoding($encoding)", $file or die "read $file: $!";
  4         8  
  4         30  
  4         154  
299              
300 4         49999 while(<$FH>) {
301 72         200 $buf .= $_;
302              
303 72 100       451 if($buf =~ s!"([^"]+)"\s*=\s*"([^"]+)(");!!s) { # key-value
    100          
    100          
304 16         43 my($key, $value) = ($1, $2);
305 16         16 warn "[$file] ($key) => ($value)\n" if DEBUG;
306 16         18 my $pos = 0;
307 16         38 $data->{$key} = $value;
308 16   66     115 $data->{$key} =~ s/\%(\d*)\$?([\d\.]*[dsf])\b/{ ++$pos; sprintf '[sprintf,%%%s,_%s]', $2, $1 || $pos }/ge;
  20         19  
  20         21  
  20         205  
309             }
310             elsif($buf =~ s!^//(.*)$!!m) { # comment
311 20         55 warn "[$file] COMMENT ($1)\n" if DEBUG;
312             }
313             elsif($buf =~ s!/\*(.*)\*/!!s) { # multi-line comment
314 4         14 warn "[$file] MULTI-LINE-COMMENT ($1)\n" if DEBUG;
315             }
316             }
317              
318 4         69 return $data;
319             }
320              
321             =head2 import
322              
323             See L for example one-liner.
324              
325             =cut
326              
327             sub import {
328 4     4   28 my $class = shift;
329              
330 4 50 33     1826 if(@_ and $_[0] eq 'generate') {
331 0         0 $class->generate(@ARGV);
332             }
333             }
334              
335             sub _mkdir {
336 1     1   7 my @path = splitdir shift;
337 1         13 my @current_path;
338              
339 1         3 for my $part (@path) {
340 4         8 push @current_path, $part;
341 4         19 my $dir = catfile @current_path;
342 4 100       55 next if -d $dir;
343 3 50       218 mkdir $dir or die "mkdir $dir: $!";
344             }
345             }
346              
347             sub _namespace_code {
348 3     3   6 my $self = shift;
349 3         8 my $namespace = $self->namespace;
350              
351 3 50       213 if(eval "require $namespace; 1") {
352 0         0 return $self;
353             }
354              
355             return <<" PACKAGE"
356             package $namespace;
357             use base 'Locale::Maketext';
358             our \%Lexicon = ( _AUTO => 1 );
359             our \%LANGUAGES = (); # key = language name, value = class name
360             "$namespace";
361             PACKAGE
362 3         143 }
363              
364             sub _package_code {
365 3     3   9 my($self, $language) = @_;
366 3         13 my $namespace = $self->namespace;
367              
368 3         218 return <<" PACKAGE";
369             \$${namespace}::LANGUAGES{$language} = "$namespace\::$language";
370             package $namespace\::$language;
371             use base '$namespace';
372             1;
373             PACKAGE
374             }
375              
376             sub _spurt {
377 2     2   6 my($content, $path) = @_;
378 2 50       205 die qq{Can't open file "$path": $!} unless open my $FH, '>', $path;
379 2 50       121 die qq{Can't write to file "$path": $!} unless defined syswrite $FH, $content;
380             }
381              
382             =head1 COPYRIGHT
383              
384             This program is free software, you can redistribute it and/or modify it under
385             the terms of the Artistic License version 2.0.
386              
387             =head1 AUTHOR
388              
389             Jan Henning Thorsen - C
390              
391             =cut
392              
393             1;