line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# BEGIN BPS TAGGED BLOCK {{{ |
2
|
|
|
|
|
|
|
# COPYRIGHT: |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This software is Copyright (c) 2003-2008 Best Practical Solutions, LLC |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# (Except where explicitly superseded by other copyright notices) |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# LICENSE: |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
14
|
|
|
|
|
|
|
# modify it under the terms of either: |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# a) Version 2 of the GNU General Public License. You should have |
17
|
|
|
|
|
|
|
# received a copy of the GNU General Public License along with this |
18
|
|
|
|
|
|
|
# program. If not, write to the Free Software Foundation, Inc., 51 |
19
|
|
|
|
|
|
|
# Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit |
20
|
|
|
|
|
|
|
# their web page on the internet at |
21
|
|
|
|
|
|
|
# http://www.gnu.org/copyleft/gpl.html. |
22
|
|
|
|
|
|
|
# |
23
|
|
|
|
|
|
|
# b) Version 1 of Perl's "Artistic License". You should have received |
24
|
|
|
|
|
|
|
# a copy of the Artistic License with this package, in the file |
25
|
|
|
|
|
|
|
# named "ARTISTIC". The license is also available at |
26
|
|
|
|
|
|
|
# http://opensource.org/licenses/artistic-license.php. |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# This work is distributed in the hope that it will be useful, but |
29
|
|
|
|
|
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of |
30
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
31
|
|
|
|
|
|
|
# General Public License for more details. |
32
|
|
|
|
|
|
|
# |
33
|
|
|
|
|
|
|
# CONTRIBUTION SUBMISSION POLICY: |
34
|
|
|
|
|
|
|
# |
35
|
|
|
|
|
|
|
# (The following paragraph is not intended to limit the rights granted |
36
|
|
|
|
|
|
|
# to you to modify and distribute this software under the terms of the |
37
|
|
|
|
|
|
|
# GNU General Public License and is only of importance to you if you |
38
|
|
|
|
|
|
|
# choose to contribute your changes and enhancements to the community |
39
|
|
|
|
|
|
|
# by submitting them to Best Practical Solutions, LLC.) |
40
|
|
|
|
|
|
|
# |
41
|
|
|
|
|
|
|
# By intentionally submitting any modifications, corrections or |
42
|
|
|
|
|
|
|
# derivatives to this work, or any other work intended for use with SVK, |
43
|
|
|
|
|
|
|
# to Best Practical Solutions, LLC, you confirm that you are the |
44
|
|
|
|
|
|
|
# copyright holder for those contributions and you grant Best Practical |
45
|
|
|
|
|
|
|
# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free, |
46
|
|
|
|
|
|
|
# perpetual, license to use, copy, create derivative works based on |
47
|
|
|
|
|
|
|
# those contributions, and sublicense and distribute those contributions |
48
|
|
|
|
|
|
|
# and any derivatives thereof. |
49
|
|
|
|
|
|
|
# |
50
|
|
|
|
|
|
|
# END BPS TAGGED BLOCK }}} |
51
|
|
|
|
|
|
|
package SVK::I18N; |
52
|
|
|
|
|
|
|
|
53
|
12
|
|
|
12
|
|
76
|
use strict; |
|
12
|
|
|
|
|
23
|
|
|
12
|
|
|
|
|
912
|
|
54
|
12
|
|
|
12
|
|
64
|
use base 'Exporter'; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
3432
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
our @EXPORT = 'loc'; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub loc { |
59
|
12
|
|
|
12
|
|
251
|
no strict 'refs'; |
|
12
|
|
|
|
|
129
|
|
|
12
|
|
|
|
|
10862
|
|
60
|
0
|
|
|
0
|
0
|
|
local $SIG{__WARN__} = sub {}; |
|
0
|
|
|
0
|
|
|
|
61
|
0
|
|
|
|
|
|
local $@; |
62
|
|
|
|
|
|
|
|
63
|
0
|
0
|
0
|
|
|
|
if ( !lang_is_english() && eval { |
64
|
0
|
|
|
|
|
|
require Locale::Maketext::Lexicon; |
65
|
0
|
|
|
|
|
|
require Locale::Maketext::Simple; |
66
|
0
|
0
|
|
|
|
|
Locale::Maketext::Simple->VERSION >= 0.13 && |
67
|
|
|
|
|
|
|
Locale::Maketext::Lexicon->VERSION >= 0.42 |
68
|
|
|
|
|
|
|
}) { |
69
|
0
|
|
|
|
|
|
Locale::Maketext::Simple->import( |
70
|
|
|
|
|
|
|
Subclass => '', |
71
|
|
|
|
|
|
|
Path => substr(__FILE__, 0, -3), |
72
|
|
|
|
|
|
|
Style => 'gettext', |
73
|
|
|
|
|
|
|
Encoding => 'locale', |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
else { |
77
|
0
|
|
|
|
|
|
*loc = *_default_gettext; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
goto &{"SVK::I18N::loc"}; |
|
0
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub _default_gettext { |
84
|
0
|
|
|
0
|
|
|
my $str = shift; |
85
|
0
|
|
|
|
|
|
$str =~ s{ |
86
|
|
|
|
|
|
|
% # leading symbol |
87
|
|
|
|
|
|
|
(?: # either one of |
88
|
|
|
|
|
|
|
\d+ # a digit, like %1 |
89
|
|
|
|
|
|
|
| # or |
90
|
|
|
|
|
|
|
(\w+|\*)\( # a function call -- 1 |
91
|
|
|
|
|
|
|
(?: # either |
92
|
|
|
|
|
|
|
%\d+ # an interpolation |
93
|
|
|
|
|
|
|
| # or |
94
|
|
|
|
|
|
|
([^,]*) # some string -- 2 |
95
|
|
|
|
|
|
|
) # end either |
96
|
|
|
|
|
|
|
(?: # maybe followed |
97
|
|
|
|
|
|
|
, # by a comma |
98
|
|
|
|
|
|
|
([^),]*) # and a param -- 3 |
99
|
|
|
|
|
|
|
)? # end maybe |
100
|
|
|
|
|
|
|
(?: # maybe followed |
101
|
|
|
|
|
|
|
, # by another comma |
102
|
|
|
|
|
|
|
([^),]*) # and a param -- 4 |
103
|
|
|
|
|
|
|
)? # end maybe |
104
|
|
|
|
|
|
|
[^)]* # and other ignorable params |
105
|
|
|
|
|
|
|
\) # closing function call |
106
|
|
|
|
|
|
|
) # closing either one of |
107
|
|
|
|
|
|
|
}{ |
108
|
0
|
|
0
|
|
|
|
my $digit = $2 || shift; |
109
|
0
|
0
|
0
|
|
|
|
$digit . ( |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
110
|
|
|
|
|
|
|
$1 ? ( |
111
|
|
|
|
|
|
|
($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') : |
112
|
|
|
|
|
|
|
($1 eq 'quant' || $1 eq '*') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) : |
113
|
|
|
|
|
|
|
'' |
114
|
|
|
|
|
|
|
) : '' |
115
|
|
|
|
|
|
|
); |
116
|
|
|
|
|
|
|
}egx; |
117
|
0
|
|
|
|
|
|
return $str; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# try to determine if the locale is English. This might yield a false |
121
|
|
|
|
|
|
|
# negative in some corner cases, but then Locale::Maketext::Simple |
122
|
|
|
|
|
|
|
# will do a more thorough analysis. This is just an optimization. |
123
|
|
|
|
|
|
|
sub lang_is_english { |
124
|
0
|
|
|
0
|
0
|
|
for my $env_name (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) { |
125
|
0
|
0
|
|
|
|
|
next if !$ENV{$env_name}; |
126
|
0
|
0
|
|
|
|
|
return 1 if $ENV{$env_name} =~ /^en/; |
127
|
0
|
|
|
|
|
|
return; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
return; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
1; |