| Filename | /usr/share/perl/5.10/Locale/Maketext/Simple.pm |
| Statements | Executed 46 statements in 1.61ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 1 | 1 | 188µs | 188µs | Locale::Maketext::Simple::load_loc |
| 2 | 2 | 2 | 110µs | 322µs | Locale::Maketext::Simple::import |
| 1 | 1 | 1 | 33µs | 33µs | Locale::Maketext::Simple::BEGIN@5 |
| 2 | 1 | 1 | 25µs | 25µs | Locale::Maketext::Simple::default_loc |
| 1 | 1 | 1 | 18µs | 22µs | Locale::Maketext::Simple::BEGIN@4 |
| 1 | 1 | 1 | 9µs | 22µs | Locale::Maketext::Simple::BEGIN@118 |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::__ANON__[:120] |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::__ANON__[:167] |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::__ANON__[:188] |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::__ANON__[:197] |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::__ANON__[:211] |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::_default_gettext |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::_escape |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::_unescape |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::auto_path |
| 0 | 0 | 0 | 0s | 0s | Locale::Maketext::Simple::reload_loc |
| 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 | 28µs | 2 | 26µs | # spent 22µs (18+4) within Locale::Maketext::Simple::BEGIN@4 which was called:
# once (18µs+4µs) by Params::Check::BEGIN@6 at line 4 # spent 22µs making 1 call to Locale::Maketext::Simple::BEGIN@4
# spent 4µs making 1 call to strict::import |
| 5 | 3 | 132µs | 1 | 33µs | # spent 33µs within Locale::Maketext::Simple::BEGIN@5 which was called:
# once (33µs+0s) by Params::Check::BEGIN@6 at line 5 # spent 33µs making 1 call to Locale::Maketext::Simple::BEGIN@5 |
| 6 | |||||
| 7 | =head1 NAME | ||||
| 8 | |||||
| - - | |||||
| 107 | # spent 322µs (110+212) within Locale::Maketext::Simple::import which was called 2 times, avg 161µs/call:
# once (74µs+156µs) by Module::Load::Conditional::BEGIN@7 at line 7 of Module/Load/Conditional.pm
# once (36µs+56µs) by Params::Check::BEGIN@6 at line 6 of Params/Check.pm | ||||
| 108 | 18 | 102µs | my ($class, %args) = @_; | ||
| 109 | |||||
| 110 | $args{Class} ||= caller; | ||||
| 111 | $args{Style} ||= 'maketext'; | ||||
| 112 | $args{Export} ||= 'loc'; | ||||
| 113 | $args{Subclass} ||= 'I18N'; | ||||
| 114 | |||||
| 115 | 2 | 188µs | my ($loc, $loc_lang) = $class->load_loc(%args); # spent 188µs making 2 calls to Locale::Maketext::Simple::load_loc, avg 94µ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.12ms | 2 | 36µs | # spent 22µs (9+13) within Locale::Maketext::Simple::BEGIN@118 which was called:
# once (9µs+13µs) by Params::Check::BEGIN@6 at line 118 # spent 22µs making 1 call to Locale::Maketext::Simple::BEGIN@118
# spent 14µ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 | 300ns | my %Loc; | ||
| 124 | |||||
| 125 | sub reload_loc { %Loc = () } | ||||
| 126 | |||||
| 127 | # spent 188µs within Locale::Maketext::Simple::load_loc which was called 2 times, avg 94µs/call:
# 2 times (188µs+0s) by Locale::Maketext::Simple::import at line 115, avg 94µs/call | ||||
| 128 | 8 | 20µ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 | 2 | 178µs | 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 | 28µ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 | 3µs | 1; | ||
| 295 | |||||
| 296 | =head1 ACKNOWLEDGMENTS | ||||
| 297 | |||||
| - - |