Filename | /usr/local/lib/perl5/site_perl/mach/5.32/Unicode/LineBreak.pm |
Statements | Executed 0 statements in 0s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN@12 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@20 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@21 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@22 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@23 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@54 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@55 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@7 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@70 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@8 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@9 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | BEGIN@99 | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | CORE:qr (opcode) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | CORE:regcomp (opcode) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | CORE:subst (opcode) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | CORE:substcont (opcode) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | EAWidths (xsub) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | LBClasses (xsub) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | config | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | context | Unicode::LineBreak::
0 | 0 | 0 | 0s | 0s | new | Unicode::LineBreak::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #-*- perl -*- | ||||
2 | |||||
3 | package Unicode::LineBreak; | ||||
4 | require 5.008; | ||||
5 | |||||
6 | ### Pragmas: | ||||
7 | use strict; | ||||
8 | use warnings; | ||||
9 | use vars qw($VERSION @EXPORT_OK @ISA $Config @Config); | ||||
10 | |||||
11 | ### Exporting: | ||||
12 | use Exporter; | ||||
13 | our @EXPORT_OK = qw(UNICODE_VERSION SOMBOK_VERSION context); | ||||
14 | our %EXPORT_TAGS = ('all' => [@EXPORT_OK]); | ||||
15 | |||||
16 | ### Inheritance: | ||||
17 | our @ISA = qw(Exporter); | ||||
18 | |||||
19 | ### Other modules: | ||||
20 | use Carp qw(croak carp); | ||||
21 | use Encode qw(is_utf8); | ||||
22 | use MIME::Charset; | ||||
23 | use Unicode::GCString; | ||||
24 | |||||
25 | ### Globals | ||||
26 | |||||
27 | ### The package version | ||||
28 | our $VERSION = '2019.001'; | ||||
29 | |||||
30 | ### Public Configuration Attributes | ||||
31 | our @Config = ( | ||||
32 | BreakIndent => 'YES', | ||||
33 | CharMax => 998, | ||||
34 | ColMax => 76, | ||||
35 | ColMin => 0, | ||||
36 | ComplexBreaking => 'YES', | ||||
37 | Context => 'NONEASTASIAN', | ||||
38 | EAWidth => undef, | ||||
39 | Format => 'SIMPLE', | ||||
40 | HangulAsAL => 'NO', | ||||
41 | LBClass => undef, | ||||
42 | LegacyCM => 'YES', | ||||
43 | Newline => "\n", | ||||
44 | Prep => undef, | ||||
45 | Sizing => 'UAX11', | ||||
46 | Urgent => undef, | ||||
47 | ViramaAsJoiner => 'YES', | ||||
48 | ); | ||||
49 | our $Config = {}; | ||||
50 | eval { require Unicode::LineBreak::Defaults; }; | ||||
51 | push @Config, (%$Config); | ||||
52 | |||||
53 | ### Exportable constants | ||||
54 | use Unicode::LineBreak::Constants; | ||||
55 | use constant 1.01; | ||||
56 | my $package = __PACKAGE__; | ||||
57 | my @consts = grep { s/^${package}::(\w\w+)$/$1/ } keys %constant::declared; | ||||
58 | push @EXPORT_OK, @consts; | ||||
59 | push @{$EXPORT_TAGS{'all'}}, @consts; | ||||
60 | |||||
61 | ### Load XS module | ||||
62 | require XSLoader; | ||||
63 | XSLoader::load('Unicode::LineBreak', $VERSION); | ||||
64 | |||||
65 | ### Load dynamic constants | ||||
66 | foreach my $p ((['EA', EAWidths()], ['LB', LBClasses()])) { | ||||
67 | my $prop = shift @{$p}; | ||||
68 | my $idx = 0; | ||||
69 | foreach my $val (@{$p}) { | ||||
70 | no strict; | ||||
71 | my $const = "${prop}_${val}"; | ||||
72 | *{$const} = eval "sub { $idx }"; # spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in string eval
# spent 0s executing statements in string eval
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 3 string evals (merged)
# spent 0s executing statements in 2 string evals (merged)
# spent 0s executing statements in string eval | ||||
73 | push @EXPORT_OK, $const; | ||||
74 | push @{$EXPORT_TAGS{'all'}}, $const; | ||||
75 | $idx++; | ||||
76 | } | ||||
77 | } | ||||
78 | |||||
79 | ### Privates | ||||
80 | my $EASTASIAN_CHARSETS = qr{ | ||||
81 | ^BIG5 | | ||||
82 | ^CP9\d\d | | ||||
83 | ^EUC- | | ||||
84 | ^GB18030 | ^GB2312 | ^GBK | | ||||
85 | ^HZ | | ||||
86 | ^ISO-2022- | | ||||
87 | ^KS_C_5601 | | ||||
88 | ^SHIFT_JIS | ||||
89 | }ix; | ||||
90 | |||||
91 | my $EASTASIAN_LANGUAGES = qr{ | ||||
92 | ^AIN | | ||||
93 | ^JA\b | ^JPN | | ||||
94 | ^KO\b | ^KOR | | ||||
95 | ^ZH\b | ^CHI | ||||
96 | }ix; | ||||
97 | |||||
98 | use overload | ||||
99 | '%{}' => \&as_hashref, | ||||
100 | '${}' => \&as_scalarref, | ||||
101 | '""' => \&as_string, | ||||
102 | ; | ||||
103 | |||||
104 | sub new { | ||||
105 | my $class = shift; | ||||
106 | |||||
107 | my $self = __PACKAGE__->_new(); | ||||
108 | $self->config(@Config); | ||||
109 | $self->config(@_); | ||||
110 | bless $self, $class; | ||||
111 | } | ||||
112 | |||||
113 | sub config ($@) { | ||||
114 | my $self = shift; | ||||
115 | |||||
116 | # Get config. | ||||
117 | if (scalar @_ == 1) { | ||||
118 | my $k = shift; | ||||
119 | my $ret; | ||||
120 | |||||
121 | if (uc $k eq uc 'CharactersMax') { | ||||
122 | return $self->_config('CharMax'); | ||||
123 | } elsif (uc $k eq uc 'ColumnsMax') { | ||||
124 | return $self->_config('ColMax'); | ||||
125 | } elsif (uc $k eq uc 'ColumnsMin') { | ||||
126 | return $self->_config('ColMin'); | ||||
127 | } elsif (uc $k eq uc 'SizingMethod') { | ||||
128 | return $self->_config('Sizing'); | ||||
129 | } elsif (uc $k eq uc 'TailorEA') { | ||||
130 | carp "$k is obsoleted. Use EAWidth"; | ||||
131 | $ret = $self->_config('EAWidth'); | ||||
132 | if (! defined $ret) { | ||||
133 | return []; | ||||
134 | } else { | ||||
135 | return [map { ($_->[0] => $_->[1]) } @{$ret}]; | ||||
136 | } | ||||
137 | } elsif (uc $k eq uc 'TailorLB') { | ||||
138 | carp "$k is obsoleted. Use LBClass"; | ||||
139 | $ret = $self->_config('LBClass'); | ||||
140 | if (! defined $ret) { | ||||
141 | return []; | ||||
142 | } else { | ||||
143 | return [map { ($_->[0] => $_->[1]) } @{$ret}]; | ||||
144 | } | ||||
145 | } elsif (uc $k eq uc 'UrgentBreaking') { | ||||
146 | return $self->_config('Urgent'); | ||||
147 | } elsif (uc $k eq uc 'UserBreaking') { | ||||
148 | carp "$k is obsoleted. Use Prep"; | ||||
149 | $ret = $self->_config('Prep'); | ||||
150 | if (! defined $ret) { | ||||
151 | return []; | ||||
152 | } else { | ||||
153 | return $ret; | ||||
154 | } | ||||
155 | } else { | ||||
156 | return $self->_config($k); | ||||
157 | } | ||||
158 | } | ||||
159 | |||||
160 | # Set config. | ||||
161 | my @config = (); | ||||
162 | while (0 < scalar @_) { | ||||
163 | my $k = shift; | ||||
164 | my $v = shift; | ||||
165 | |||||
166 | if (uc $k eq uc 'CharactersMax') { | ||||
167 | push @config, 'CharMax' => $v; | ||||
168 | } elsif (uc $k eq uc 'ColumnsMax') { | ||||
169 | push @config, 'ColMax' => $v; | ||||
170 | } elsif (uc $k eq uc 'ColumnsMin') { | ||||
171 | push @config, 'ColMin' => $v; | ||||
172 | } elsif (uc $k eq uc 'SizingMethod') { | ||||
173 | push @config, 'Sizing' => $v; | ||||
174 | } elsif (uc $k eq uc 'TailorLB') { | ||||
175 | carp "$k is obsoleted. Use LBClass"; | ||||
176 | push @config, 'LBClass' => undef; | ||||
177 | if (! defined $v) { | ||||
178 | ; | ||||
179 | } else { | ||||
180 | my @v = @{$v}; | ||||
181 | while (scalar(@v)) { | ||||
182 | my $k = shift @v; | ||||
183 | my $v = shift @v; | ||||
184 | push @config, 'LBClass' => [ $k => $v ]; | ||||
185 | } | ||||
186 | } | ||||
187 | } elsif (uc $k eq uc 'TailorEA') { | ||||
188 | carp "$k is obsoleted. Use EAWidth"; | ||||
189 | push @config, 'EAWidth' => undef; | ||||
190 | if (! defined $v) { | ||||
191 | ; | ||||
192 | } else { | ||||
193 | my @v = @{$v}; | ||||
194 | while (scalar(@v)) { | ||||
195 | my $k = shift @v; | ||||
196 | my $v = shift @v; | ||||
197 | push @config, 'EAWidth' => [ $k => $v ]; | ||||
198 | } | ||||
199 | } | ||||
200 | } elsif (uc $k eq uc 'UserBreaking') { | ||||
201 | carp "$k is obsoleted. Use Prep"; | ||||
202 | push @config, 'Prep' => undef; | ||||
203 | if (! defined $v) { | ||||
204 | ; | ||||
205 | } elsif (ref $v eq 'ARRAY') { | ||||
206 | push @config, map { ('Prep' => $_) } @{$v}; | ||||
207 | } else { | ||||
208 | push @config, 'Prep' => $v; | ||||
209 | } | ||||
210 | } elsif (uc $k eq uc 'UrgentBreaking') { | ||||
211 | push @config, 'Urgent' => $v; | ||||
212 | } else { | ||||
213 | push @config, $k => $v; | ||||
214 | } | ||||
215 | } | ||||
216 | |||||
217 | $self->_config(@config) if scalar @config; | ||||
218 | } | ||||
219 | |||||
220 | sub context (@) { | ||||
221 | my %opts = @_; | ||||
222 | |||||
223 | my $charset; | ||||
224 | my $language; | ||||
225 | my $context; | ||||
226 | foreach my $k (keys %opts) { | ||||
227 | if (uc $k eq 'CHARSET') { | ||||
228 | if (ref $opts{$k}) { | ||||
229 | $charset = $opts{$k}->as_string; | ||||
230 | } else { | ||||
231 | $charset = MIME::Charset->new($opts{$k})->as_string; | ||||
232 | } | ||||
233 | } elsif (uc $k eq 'LANGUAGE') { | ||||
234 | $language = uc $opts{$k}; | ||||
235 | $language =~ s/_/-/; | ||||
236 | } | ||||
237 | } | ||||
238 | if ($charset and $charset =~ /$EASTASIAN_CHARSETS/) { | ||||
239 | $context = 'EASTASIAN'; | ||||
240 | } elsif ($language and $language =~ /$EASTASIAN_LANGUAGES/) { | ||||
241 | $context = 'EASTASIAN'; | ||||
242 | } else { | ||||
243 | $context = 'NONEASTASIAN'; | ||||
244 | } | ||||
245 | $context; | ||||
246 | } | ||||
247 | |||||
248 | 1; |