Filename | /usr/share/perl/5.10/Locale/Maketext/Simple.pm |
Statements | Executed 46 statements in 1.65ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 173µs | 173µs | load_loc | Locale::Maketext::Simple::
2 | 2 | 2 | 101µs | 299µs | import | Locale::Maketext::Simple::
1 | 1 | 1 | 31µs | 31µs | BEGIN@5 | Locale::Maketext::Simple::
2 | 1 | 1 | 25µs | 25µs | default_loc | Locale::Maketext::Simple::
1 | 1 | 1 | 20µs | 28µs | BEGIN@4 | Locale::Maketext::Simple::
1 | 1 | 1 | 9µs | 24µs | BEGIN@118 | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:120] | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:167] | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:188] | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:197] | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | __ANON__[:211] | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | _default_gettext | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | _escape | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | _unescape | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | auto_path | Locale::Maketext::Simple::
0 | 0 | 0 | 0s | 0s | reload_loc | Locale::Maketext::Simple::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Locale::Maketext::Simple; | ||||
2 | 1 | 800ns | $Locale::Maketext::Simple::VERSION = '0.18'; | ||
3 | |||||
4 | 3 | 30µs | 2 | 36µs | # spent 28µs (20+8) within Locale::Maketext::Simple::BEGIN@4 which was called:
# once (20µs+8µs) by Params::Check::BEGIN@6 at line 4 # spent 28µs making 1 call to Locale::Maketext::Simple::BEGIN@4
# spent 8µs making 1 call to strict::import |
5 | 3 | 131µs | 1 | 31µs | # spent 31µs within Locale::Maketext::Simple::BEGIN@5 which was called:
# once (31µs+0s) by Params::Check::BEGIN@6 at line 5 # spent 31µs making 1 call to Locale::Maketext::Simple::BEGIN@5 |
6 | |||||
7 | =head1 NAME | ||||
8 | |||||
- - | |||||
107 | # spent 299µs (101+198) within Locale::Maketext::Simple::import which was called 2 times, avg 150µs/call:
# once (58µs+109µs) by Params::Check::BEGIN@6 at line 6 of Params/Check.pm
# once (43µs+89µs) by Module::Load::Conditional::BEGIN@7 at line 7 of Module/Load/Conditional.pm | ||||
108 | 18 | 85µs | my ($class, %args) = @_; | ||
109 | |||||
110 | $args{Class} ||= caller; | ||||
111 | $args{Style} ||= 'maketext'; | ||||
112 | $args{Export} ||= 'loc'; | ||||
113 | $args{Subclass} ||= 'I18N'; | ||||
114 | |||||
115 | 2 | 173µs | my ($loc, $loc_lang) = $class->load_loc(%args); # spent 173µs making 2 calls to Locale::Maketext::Simple::load_loc, avg 87µs/call | ||
116 | 2 | 25µs | $loc ||= $class->default_loc(%args); # spent 25µs making 2 calls to Locale::Maketext::Simple::default_loc, avg 12µs/call | ||
117 | |||||
118 | 3 | 1.19ms | 2 | 39µs | # spent 24µs (9+15) within Locale::Maketext::Simple::BEGIN@118 which was called:
# once (9µs+15µs) by Params::Check::BEGIN@6 at line 118 # spent 24µs making 1 call to Locale::Maketext::Simple::BEGIN@118
# spent 15µs making 1 call to strict::unimport |
119 | *{caller(0) . "::$args{Export}"} = $loc if $args{Export}; | ||||
120 | *{caller(0) . "::$args{Export}_lang"} = $loc_lang || sub { 1 }; | ||||
121 | } | ||||
122 | |||||
123 | 1 | 400ns | my %Loc; | ||
124 | |||||
125 | sub reload_loc { %Loc = () } | ||||
126 | |||||
127 | # spent 173µs within Locale::Maketext::Simple::load_loc which was called 2 times, avg 87µs/call:
# 2 times (173µs+0s) by Locale::Maketext::Simple::import at line 115, avg 87µs/call | ||||
128 | 10 | 183µs | my ($class, %args) = @_; | ||
129 | |||||
130 | my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass}); | ||||
131 | return $Loc{$pkg} if exists $Loc{$pkg}; | ||||
132 | |||||
133 | eval { require Locale::Maketext::Lexicon; 1 } or return; | ||||
134 | $Locale::Maketext::Lexicon::VERSION > 0.20 or return; | ||||
135 | eval { require File::Spec; 1 } or return; | ||||
136 | |||||
137 | my $path = $args{Path} || $class->auto_path($args{Class}) or return; | ||||
138 | my $pattern = File::Spec->catfile($path, '*.[pm]o'); | ||||
139 | my $decode = $args{Decode} || 0; | ||||
140 | my $encoding = $args{Encoding} || undef; | ||||
141 | |||||
142 | $decode = 1 if $encoding; | ||||
143 | |||||
144 | $pattern =~ s{\\}{/}g; # to counter win32 paths | ||||
145 | |||||
146 | eval " | ||||
147 | package $pkg; | ||||
148 | use base 'Locale::Maketext'; | ||||
149 | %${pkg}::Lexicon = ( '_AUTO' => 1 ); | ||||
150 | Locale::Maketext::Lexicon->import({ | ||||
151 | 'i-default' => [ 'Auto' ], | ||||
152 | '*' => [ Gettext => \$pattern ], | ||||
153 | _decode => \$decode, | ||||
154 | _encoding => \$encoding, | ||||
155 | }); | ||||
156 | *tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') } | ||||
157 | unless defined &tense; | ||||
158 | |||||
159 | 1; | ||||
160 | " or die $@; | ||||
161 | |||||
162 | my $lh = eval { $pkg->get_handle } or return; | ||||
163 | my $style = lc($args{Style}); | ||||
164 | if ($style eq 'maketext') { | ||||
165 | $Loc{$pkg} = sub { | ||||
166 | $lh->maketext(@_) | ||||
167 | }; | ||||
168 | } | ||||
169 | elsif ($style eq 'gettext') { | ||||
170 | $Loc{$pkg} = sub { | ||||
171 | my $str = shift; | ||||
172 | $str =~ s{([\~\[\]])}{~$1}g; | ||||
173 | $str =~ s{ | ||||
174 | ([%\\]%) # 1 - escaped sequence | ||||
175 | | | ||||
176 | % (?: | ||||
177 | ([A-Za-z#*]\w*) # 2 - function call | ||||
178 | \(([^\)]*)\) # 3 - arguments | ||||
179 | | | ||||
180 | ([1-9]\d*|\*) # 4 - variable | ||||
181 | ) | ||||
182 | }{ | ||||
183 | $1 ? $1 | ||||
184 | : $2 ? "\[$2,"._unescape($3)."]" | ||||
185 | : "[_$4]" | ||||
186 | }egx; | ||||
187 | return $lh->maketext($str, @_); | ||||
188 | }; | ||||
189 | } | ||||
190 | else { | ||||
191 | die "Unknown Style: $style"; | ||||
192 | } | ||||
193 | |||||
194 | return $Loc{$pkg}, sub { | ||||
195 | $lh = $pkg->get_handle(@_); | ||||
196 | $lh = $pkg->get_handle(@_); | ||||
197 | }; | ||||
198 | } | ||||
199 | |||||
200 | # spent 25µs within Locale::Maketext::Simple::default_loc which was called 2 times, avg 12µs/call:
# 2 times (25µs+0s) by Locale::Maketext::Simple::import at line 116, avg 12µs/call | ||||
201 | 6 | 31µs | my ($self, %args) = @_; | ||
202 | my $style = lc($args{Style}); | ||||
203 | if ($style eq 'maketext') { | ||||
204 | return sub { | ||||
205 | my $str = shift; | ||||
206 | $str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]} | ||||
207 | {$1%$2}g; | ||||
208 | $str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]} | ||||
209 | {"$1%$2(" . _escape($3) . ')'}eg; | ||||
210 | _default_gettext($str, @_); | ||||
211 | }; | ||||
212 | } | ||||
213 | elsif ($style eq 'gettext') { | ||||
214 | return \&_default_gettext; | ||||
215 | } | ||||
216 | else { | ||||
217 | die "Unknown Style: $style"; | ||||
218 | } | ||||
219 | } | ||||
220 | |||||
221 | sub _default_gettext { | ||||
222 | my $str = shift; | ||||
223 | $str =~ s{ | ||||
224 | % # leading symbol | ||||
225 | (?: # either one of | ||||
226 | \d+ # a digit, like %1 | ||||
227 | | # or | ||||
228 | (\w+)\( # a function call -- 1 | ||||
229 | (?: # either | ||||
230 | %\d+ # an interpolation | ||||
231 | | # or | ||||
232 | ([^,]*) # some string -- 2 | ||||
233 | ) # end either | ||||
234 | (?: # maybe followed | ||||
235 | , # by a comma | ||||
236 | ([^),]*) # and a param -- 3 | ||||
237 | )? # end maybe | ||||
238 | (?: # maybe followed | ||||
239 | , # by another comma | ||||
240 | ([^),]*) # and a param -- 4 | ||||
241 | )? # end maybe | ||||
242 | [^)]* # and other ignorable params | ||||
243 | \) # closing function call | ||||
244 | ) # closing either one of | ||||
245 | }{ | ||||
246 | my $digit = $2 || shift; | ||||
247 | $digit . ( | ||||
248 | $1 ? ( | ||||
249 | ($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') : | ||||
250 | ($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) : | ||||
251 | '' | ||||
252 | ) : '' | ||||
253 | ); | ||||
254 | }egx; | ||||
255 | return $str; | ||||
256 | }; | ||||
257 | |||||
258 | sub _escape { | ||||
259 | my $text = shift; | ||||
260 | $text =~ s/\b_([1-9]\d*)/%$1/g; | ||||
261 | return $text; | ||||
262 | } | ||||
263 | |||||
264 | sub _unescape { | ||||
265 | join(',', map { | ||||
266 | /\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_ | ||||
267 | } split(/,/, $_[0])); | ||||
268 | } | ||||
269 | |||||
270 | sub auto_path { | ||||
271 | my ($self, $calldir) = @_; | ||||
272 | $calldir =~ s#::#/#g; | ||||
273 | my $path = $INC{$calldir . '.pm'} or return; | ||||
274 | |||||
275 | # Try absolute path name. | ||||
276 | if ($^O eq 'MacOS') { | ||||
277 | (my $malldir = $calldir) =~ tr#/#:#; | ||||
278 | $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s; | ||||
279 | } else { | ||||
280 | $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#; | ||||
281 | } | ||||
282 | |||||
283 | return $path if -d $path; | ||||
284 | |||||
285 | # If that failed, try relative path with normal @INC searching. | ||||
286 | $path = "auto/$calldir/"; | ||||
287 | foreach my $inc (@INC) { | ||||
288 | return "$inc/$path" if -d "$inc/$path"; | ||||
289 | } | ||||
290 | |||||
291 | return; | ||||
292 | } | ||||
293 | |||||
294 | 1 | 5µs | 1; | ||
295 | |||||
296 | =head1 ACKNOWLEDGMENTS | ||||
297 | |||||
- - |