File Coverage

blib/lib/Data/Localize.pm
Criterion Covered Total %
statement 104 122 85.2
branch 19 30 63.3
condition 6 14 42.8
subroutine 23 28 82.1
pod 15 16 93.7
total 167 210 79.5


line stmt bran cond sub pod time code
1             package Data::Localize;
2 6     6   34428 use Moo;
  6         58621  
  6         54  
3 6     6   9365 use Module::Load ();
  6         4902  
  6         97  
4 6     6   30 use Scalar::Util ();
  6         9  
  6         62  
5 6     6   3219 use I18N::LangTags ();
  6         13839  
  6         135  
6 6     6   3124 use I18N::LangTags::Detect ();
  6         9481  
  6         110  
7 6     6   85 use 5.008;
  6         13  
  6         469  
8              
9             our $VERSION = '0.00027';
10             our $AUTHORITY = 'cpan:DMAKI';
11              
12             BEGIN {
13 6 50   6   28 if (! defined &DEBUG) {
14 6         27 require constant;
15 6         506 constant->import(DEBUG => !!$ENV{DATA_LOCALIZE_DEBUG});
16             }
17             }
18              
19             BEGIN {
20 6     6   9094 if (DEBUG) {
21             require Data::Localize::Log;
22             Data::Localize::Log->import;
23             }
24             }
25              
26             has auto => (
27             is => 'rw',
28             default => sub { 1 },
29             );
30              
31             has auto_localizer => (
32             is => 'rw',
33             lazy => 1,
34             builder => "_build_auto_localizer",
35             isa => sub { $_[0]->isa('Data::Localize::Auto') },
36             );
37              
38             has _languages => (
39             is => 'rw',
40             lazy => 1,
41             builder => "_build__languages",
42             init_arg => 'languages',
43             );
44              
45             has _fallback_languages => (
46             is => 'rw',
47             lazy => 1,
48             builder => "_build__fallback_languages",
49             init_arg => 'fallback_languages',
50             );
51              
52             has _localizers => (
53             is => 'rw',
54             coerce => sub {
55             if (ref $_[0] ne 'ARRAY') {
56             Carp::croak("localizer list must be a list of Localizer objects");
57             }
58              
59             # XXX Want to deprecate this auto-instantiation
60             foreach my $args (@{$_[0]}) {
61             if (Scalar::Util::blessed($args)) {
62             next;
63             }
64              
65             my $klass = delete $args->{class};
66             if (! $klass) {
67             Carp::croak("No class provided for localizer list");
68             }
69             if ($klass !~ s/^\+//) {
70             $klass = "Data::Localize::$klass";
71             }
72             Module::Load::load($klass);
73             $args = $klass->new(%$args);
74             }
75             $_[0];
76             },
77             default => sub { +[] },
78             init_arg => 'localizers',
79             );
80              
81             has localizer_map => (
82             is => 'ro',
83             default => sub { +{} },
84             );
85              
86             sub BUILD {
87 7     7 0 35 my $self = shift;
88              
89 7 50       25 if ($self->count_localizers > 0) {
90 0         0 foreach my $loc (@{ $self->_localizers }) {
  0         0  
91 0         0 $loc->register($self);
92             }
93             }
94 7         2753 return $self;
95             }
96              
97             sub _build__fallback_languages {
98 2     2   409 return [ 'en' ];
99             }
100              
101             sub _build__languages {
102 3     3   664 my $self = shift;
103 3         15 $self->detect_languages();
104             }
105              
106             sub _build_auto_localizer {
107 2     2   1133 my $self = shift;
108 2         896 require Data::Localize::Auto;
109 2         16 Data::Localize::Auto->new();
110             }
111              
112             sub set_languages {
113 2     2 1 400 my $self = shift;
114 2 50       34 $self->_languages([ @_ > 0 ? @_ : $self->detect_languages ]);
115             };
116              
117              
118             sub add_fallback_languages {
119 0     0 1 0 my $self = shift;
120 0         0 push @{$self->_fallback_languages}, @_;
  0         0  
121             }
122              
123             sub fallback_languages {
124 3     3 1 595 my $self = shift;
125 3         3 return @{$self->_fallback_languages};
  3         28  
126             }
127              
128             sub languages {
129 23     23 1 29 my $self = shift;
130 23         25 return @{$self->_languages};
  23         427  
131             }
132              
133             sub localizers {
134 3     3 1 1666 my $self = shift;
135 3         78 return $self->_localizers;
136             }
137              
138             sub count_localizers {
139 8     8 1 14 my $self = shift;
140 8         12 return scalar @{$self->_localizers};
  8         55  
141             }
142              
143             sub grep_localizers {
144 0     0 1 0 my ($self, $cb) = @_;
145 0         0 grep { $cb->($_) } @{$self->_localizers};
  0         0  
  0         0  
146             }
147              
148             sub get_localizer_from_lang {
149 40     40 1 44 my ($self, $key) = @_;
150 40         151 return $self->localizer_map->{$key};
151             }
152              
153             sub set_localizer_map {
154 14     14 1 17 my ($self, $key, $value) = @_;
155 14         34 return $self->localizer_map->{$key} = $value;
156             }
157              
158             sub detect_languages {
159 3     3 1 4 my $self = shift;
160 3   33     11 my @lang = I18N::LangTags::implicate_supers(
161             I18N::LangTags::Detect::detect() ||
162             $self->fallback_languages,
163             );
164 3         527 if (DEBUG) {
165             local $Log::Minimal::AUTODUMP = 1;
166             debugf("detect_languages: auto-detected %s", \@lang);;
167             }
168 3 50       16 return wantarray ? @lang : \@lang;
169             }
170              
171             sub detect_languages_from_header {
172 0     0 1 0 my $self = shift;
173 0   0     0 my @lang = I18N::LangTags::implicate_supers(
174             I18N::LangTags::Detect->http_accept_langs( $_[0] || $ENV{HTTP_ACCEPT_LANGUAGE}),
175             $self->fallback_languages,
176             );
177 0         0 if (DEBUG) {
178             local $Log::Minimal::AUTODUMP = 1;
179             debugf("detect_languages_from_header detected %s", \@lang);
180             }
181 0 0       0 return wantarray ? @lang : \@lang;
182             }
183              
184             sub localize {
185 20     20 1 1538 my ($self, $key, @args) = @_;
186              
187 20         18 if (DEBUG) {
188             debugf("localize - Looking up key '%s'", $key);
189             }
190 20         46 my @languages = $self->languages ;
191 20         844 if (DEBUG) {
192             local $Log::Minimal::AUTODUMP = 1;
193             debugf("localize - Loaded languages %s", \@languages);
194             }
195 20         36 foreach my $lang (@languages) {
196 21         19 if (DEBUG) {
197             debugf("localize - Attempting language '%s'", $lang);
198             }
199 21   100     43 my $localizers = $self->get_localizer_from_lang($lang) || [];
200 21         23 if (DEBUG) {
201             debugf("localize - Loaded %d localizers for lang %s",
202             scalar @$localizers,
203             $lang
204             );
205             }
206 21         36 foreach my $localizer (@$localizers) {
207 18         18 if (DEBUG) {
208             local $Log::Minimal::AUTODUMP = 1;
209             debugf("localize - Trying with %s", $localizer);
210             }
211 18         79 my $out = $localizer->localize_for(
212             lang => $lang,
213             id => $key,
214             args => \@args
215             );
216              
217 18 100       46 if ($out) {
218 15         12 if (DEBUG) {
219             debugf("localize - Got localization: '%s'", $out);
220             }
221 15         65 return $out;
222             }
223             }
224             }
225              
226 5         8 if (DEBUG) {
227             debugf("localize - nothing found in registered languages");
228             }
229              
230             # if we got here, we missed on all languages.
231             # one last shot. try the '*' slot
232 5 100       6 foreach my $localizer (@{$self->get_localizer_from_lang('*') || []}) {
  5         22  
233 3         9 foreach my $lang ($self->languages) {
234 4         20 if (DEBUG) {
235             debugf("localize - trying %s for '*' with localizer %s",
236             $lang,
237             $localizer
238             );
239             }
240 4         18 my $out = $localizer->localize_for(
241             lang => $lang,
242             id => $key,
243             args => \@args
244             );
245 4 100       20 if ($out) {
246 1         1 if (DEBUG) {
247             debugf("localize - found for %s, adding to map", $lang);
248             }
249              
250             # oh, found one? set it in the localizer map so we don't have
251             # to look it up again
252 1         3 $self->add_localizer_map($lang, $localizer);
253 1         5 return $out;
254             }
255             }
256             }
257              
258             # if you got here, and you /still/ can't find a proper localization,
259             # then we fallback to 'auto' feature
260 4 100       24 if ($self->auto) {
261 3         3 if (DEBUG) {
262             debugf("localize - trying auto-lexicon for '%s'", $key);
263             }
264 3         32 return $self->auto_localizer->localize_for(id => $key, args => \@args);
265             }
266              
267 1         10 return ();
268             }
269              
270             sub add_localizer {
271 6     6 1 52 my $self = shift;
272              
273 6         10 my $localizer;
274 6 100       18 if (@_ == 1) {
275 2         5 $localizer = $_[0];
276             } else {
277 4         14 my %args = @_;
278              
279 4         12 my $klass = delete $args{class};
280 4 50       15 if ($klass !~ s/^\+//) {
281 4         12 $klass = "Data::Localize::$klass";
282             }
283 4         19 Module::Load::load($klass);
284 4         109 if (Data::Localize::DEBUG) {
285             local $Log::Minimal::AUTODUMP = 1;
286             debugf("Creating localizer '%s' (%s)", $klass, \%args);
287             }
288 4         53 $localizer = $klass->new(%args);
289             }
290              
291 6 100 33     155 if (! $localizer || ! Scalar::Util::blessed($localizer) || ! $localizer->isa( 'Data::Localize::Localizer' ) ) {
      66        
292 1 50       161 Carp::confess("Bad localizer: '" . ( defined $localizer ? $localizer : '(null)' ) . "'");
293             }
294              
295 5         44 if (DEBUG()) {
296             debugf("add_localizer: %s", $localizer);
297             }
298 5         104 $localizer->register($self);
299 5         10 push @{ $self->_localizers }, $localizer;
  5         105  
300             }
301              
302             sub find_localizers {
303 0     0 1 0 my ($self, %args) = @_;
304              
305 0 0       0 if (my $isa = $args{isa}) {
306 0     0   0 return $self->grep_localizers(sub { $_[0]->isa($isa) });
  0         0  
307             }
308             }
309              
310             sub add_localizer_map {
311 14     14 1 21 my ($self, $lang, $localizer) = @_;
312              
313 14         11 if (DEBUG) {
314             debugf("add_localizer_map %s -> %s", $lang, $localizer);
315             }
316 14         27 my $list = $self->get_localizer_from_lang($lang);
317 14 50       27 if (! $list) {
318 14         22 $list = [];
319 14         26 $self->set_localizer_map($lang, $list);
320             }
321 14         87 unshift @$list, $localizer;
322             }
323              
324             1;
325              
326             __END__