File Coverage

blib/lib/Data/Localize.pm
Criterion Covered Total %
statement 102 122 83.6
branch 16 30 53.3
condition 6 14 42.8
subroutine 22 28 78.5
pod 15 16 93.7
total 161 210 76.6


line stmt bran cond sub pod time code
1             package Data::Localize;
2 5     5   49522 use Moo;
  5         82655  
  5         37  
3 5     5   13689 use Module::Load ();
  5         5794  
  5         102  
4 5     5   35 use Scalar::Util ();
  5         12  
  5         78  
5 5     5   5434 use I18N::LangTags ();
  5         16069  
  5         155  
6 5     5   5375 use I18N::LangTags::Detect ();
  5         12397  
  5         123  
7 5     5   118 use 5.008;
  5         15  
  5         492  
8              
9             our $VERSION = '0.00026';
10             our $AUTHORITY = 'cpan:DMAKI';
11              
12             BEGIN {
13 5 50   5   32 if (! defined &DEBUG) {
14 5         28 require constant;
15 5         520 constant->import(DEBUG => !!$ENV{DATA_LOCALIZE_DEBUG});
16             }
17             }
18              
19             BEGIN {
20 5     5   11312 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 6     6 0 40 my $self = shift;
88              
89 6 50       28 if ($self->count_localizers > 0) {
90 0         0 foreach my $loc (@{ $self->_localizers }) {
  0         0  
91 0         0 $loc->register($self);
92             }
93             }
94 6         3169 return $self;
95             }
96              
97             sub _build__fallback_languages {
98 2     2   552 return [ 'en' ];
99             }
100              
101             sub _build__languages {
102 3     3   1037 my $self = shift;
103 3         22 $self->detect_languages();
104             }
105              
106             sub _build_auto_localizer {
107 1     1   744 my $self = shift;
108 1         606 require Data::Localize::Auto;
109 1         11 Data::Localize::Auto->new();
110             }
111              
112             sub set_languages {
113 0     0 1 0 my $self = shift;
114 0 0       0 $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 1418 my $self = shift;
125 3         6 return @{$self->_fallback_languages};
  3         42  
126             }
127              
128             sub languages {
129 9     9 1 15 my $self = shift;
130 9         14 return @{$self->_languages};
  9         150  
131             }
132              
133             sub localizers {
134 3     3 1 2634 my $self = shift;
135 3         90 return $self->_localizers;
136             }
137              
138             sub count_localizers {
139 7     7 1 21 my $self = shift;
140 7         16 return scalar @{$self->_localizers};
  7         67  
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 22     22 1 43 my ($self, $key) = @_;
150 22         119 return $self->localizer_map->{$key};
151             }
152              
153             sub set_localizer_map {
154 11     11 1 21 my ($self, $key, $value) = @_;
155 11         41 return $self->localizer_map->{$key} = $value;
156             }
157              
158             sub detect_languages {
159 3     3 1 8 my $self = shift;
160 3   33     22 my @lang = I18N::LangTags::implicate_supers(
161             I18N::LangTags::Detect::detect() ||
162             $self->fallback_languages,
163             );
164 3         838 if (DEBUG) {
165             local $Log::Minimal::AUTODUMP = 1;
166             debugf("detect_languages: auto-detected %s", \@lang);;
167             }
168 3 50       26 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 8     8 1 1666 my ($self, $key, @args) = @_;
186              
187 8         14 if (DEBUG) {
188             debugf("localize - Looking up key '%s'", $key);
189             }
190 8         29 my @languages = $self->languages ;
191 8         976 if (DEBUG) {
192             local $Log::Minimal::AUTODUMP = 1;
193             debugf("localize - Loaded languages %s", \@languages);
194             }
195 8         21 foreach my $lang (@languages) {
196 8         22 if (DEBUG) {
197             debugf("localize - Attempting language '%s'", $lang);
198             }
199 8   100     27 my $localizers = $self->get_localizer_from_lang($lang) || [];
200 8         17 if (DEBUG) {
201             debugf("localize - Loaded %d localizers for lang %s",
202             scalar @$localizers,
203             $lang
204             );
205             }
206 8         27 foreach my $localizer (@$localizers) {
207 5         12 if (DEBUG) {
208             local $Log::Minimal::AUTODUMP = 1;
209             debugf("localize - Trying with %s", $localizer);
210             }
211 5         43 my $out = $localizer->localize_for(
212             lang => $lang,
213             id => $key,
214             args => \@args
215             );
216              
217 5 50       22 if ($out) {
218 5         7 if (DEBUG) {
219             debugf("localize - Got localization: '%s'", $out);
220             }
221 5         35 return $out;
222             }
223             }
224             }
225              
226 3         5 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 3 100       6 foreach my $localizer (@{$self->get_localizer_from_lang('*') || []}) {
  3         16  
233 1         5 foreach my $lang ($self->languages) {
234 1         9 if (DEBUG) {
235             debugf("localize - trying %s for '*' with localizer %s",
236             $lang,
237             $localizer
238             );
239             }
240 1         9 my $out = $localizer->localize_for(
241             lang => $lang,
242             id => $key,
243             args => \@args
244             );
245 1 50       5 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         4 $self->add_localizer_map($lang, $localizer);
253 1         4 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 2 100       16 if ($self->auto) {
261 1         2 if (DEBUG) {
262             debugf("localize - trying auto-lexicon for '%s'", $key);
263             }
264 1         6 return $self->auto_localizer->localize_for(id => $key, args => \@args);
265             }
266              
267 1         11 return ();
268             }
269              
270             sub add_localizer {
271 5     5 1 55 my $self = shift;
272              
273 5         12 my $localizer;
274 5 100       86 if (@_ == 1) {
275 2         7 $localizer = $_[0];
276             } else {
277 3         18 my %args = @_;
278              
279 3         10 my $klass = delete $args{class};
280 3 50       16 if ($klass !~ s/^\+//) {
281 3         11 $klass = "Data::Localize::$klass";
282             }
283 3         18 Module::Load::load($klass);
284 3         161 if (Data::Localize::DEBUG) {
285             local $Log::Minimal::AUTODUMP = 1;
286             debugf("Creating localizer '%s' (%s)", $klass, \%args);
287             }
288 3         72 $localizer = $klass->new(%args);
289             }
290              
291 5 100 33     161 if (! $localizer || ! Scalar::Util::blessed($localizer) || ! $localizer->isa( 'Data::Localize::Localizer' ) ) {
      66        
292 1 50       222 Carp::confess("Bad localizer: '" . ( defined $localizer ? $localizer : '(null)' ) . "'");
293             }
294              
295 4         9 if (DEBUG()) {
296             debugf("add_localizer: %s", $localizer);
297             }
298 4         127 $localizer->register($self);
299 4         8 push @{ $self->_localizers }, $localizer;
  4         122  
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 11     11 1 24 my ($self, $lang, $localizer) = @_;
312              
313 11         16 if (DEBUG) {
314             debugf("add_localizer_map %s -> %s", $lang, $localizer);
315             }
316 11         32 my $list = $self->get_localizer_from_lang($lang);
317 11 50       33 if (! $list) {
318 11         20 $list = [];
319 11         32 $self->set_localizer_map($lang, $list);
320             }
321 11         104 unshift @$list, $localizer;
322             }
323              
324             1;
325              
326             __END__