← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:08 2021

Filename/usr/local/lib/perl5/site_perl/mach/5.32/Unicode/LineBreak.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sUnicode::LineBreak::::BEGIN@12Unicode::LineBreak::BEGIN@12
0000s0sUnicode::LineBreak::::BEGIN@20Unicode::LineBreak::BEGIN@20
0000s0sUnicode::LineBreak::::BEGIN@21Unicode::LineBreak::BEGIN@21
0000s0sUnicode::LineBreak::::BEGIN@22Unicode::LineBreak::BEGIN@22
0000s0sUnicode::LineBreak::::BEGIN@23Unicode::LineBreak::BEGIN@23
0000s0sUnicode::LineBreak::::BEGIN@54Unicode::LineBreak::BEGIN@54
0000s0sUnicode::LineBreak::::BEGIN@55Unicode::LineBreak::BEGIN@55
0000s0sUnicode::LineBreak::::BEGIN@7Unicode::LineBreak::BEGIN@7
0000s0sUnicode::LineBreak::::BEGIN@70Unicode::LineBreak::BEGIN@70
0000s0sUnicode::LineBreak::::BEGIN@8Unicode::LineBreak::BEGIN@8
0000s0sUnicode::LineBreak::::BEGIN@9Unicode::LineBreak::BEGIN@9
0000s0sUnicode::LineBreak::::BEGIN@99Unicode::LineBreak::BEGIN@99
0000s0sUnicode::LineBreak::::CORE:qrUnicode::LineBreak::CORE:qr (opcode)
0000s0sUnicode::LineBreak::::CORE:regcompUnicode::LineBreak::CORE:regcomp (opcode)
0000s0sUnicode::LineBreak::::CORE:substUnicode::LineBreak::CORE:subst (opcode)
0000s0sUnicode::LineBreak::::CORE:substcontUnicode::LineBreak::CORE:substcont (opcode)
0000s0sUnicode::LineBreak::::EAWidthsUnicode::LineBreak::EAWidths (xsub)
0000s0sUnicode::LineBreak::::LBClassesUnicode::LineBreak::LBClasses (xsub)
0000s0sUnicode::LineBreak::::__ANON__Unicode::LineBreak::__ANON__ (xsub)
0000s0sUnicode::LineBreak::::configUnicode::LineBreak::config
0000s0sUnicode::LineBreak::::contextUnicode::LineBreak::context
0000s0sUnicode::LineBreak::::newUnicode::LineBreak::new
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#-*- perl -*-
2
3package Unicode::LineBreak;
4require 5.008;
5
6### Pragmas:
7use strict;
8use warnings;
9use vars qw($VERSION @EXPORT_OK @ISA $Config @Config);
10
11### Exporting:
12use Exporter;
13our @EXPORT_OK = qw(UNICODE_VERSION SOMBOK_VERSION context);
14our %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
15
16### Inheritance:
17our @ISA = qw(Exporter);
18
19### Other modules:
20use Carp qw(croak carp);
21use Encode qw(is_utf8);
22use MIME::Charset;
23use Unicode::GCString;
24
25### Globals
26
27### The package version
28our $VERSION = '2019.001';
29
30### Public Configuration Attributes
31our @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);
49our $Config = {};
50eval { require Unicode::LineBreak::Defaults; };
51push @Config, (%$Config);
52
53### Exportable constants
54use Unicode::LineBreak::Constants;
55use constant 1.01;
56my $package = __PACKAGE__;
57my @consts = grep { s/^${package}::(\w\w+)$/$1/ } keys %constant::declared;
58push @EXPORT_OK, @consts;
59push @{$EXPORT_TAGS{'all'}}, @consts;
60
61### Load XS module
62require XSLoader;
63XSLoader::load('Unicode::LineBreak', $VERSION);
64
65### Load dynamic constants
66foreach 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
80my $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
91my $EASTASIAN_LANGUAGES = qr{
92 ^AIN |
93 ^JA\b | ^JPN |
94 ^KO\b | ^KOR |
95 ^ZH\b | ^CHI
96}ix;
97
98use overload
99 '%{}' => \&as_hashref,
100 '${}' => \&as_scalarref,
101 '""' => \&as_string,
102 ;
103
104sub new {
105 my $class = shift;
106
107 my $self = __PACKAGE__->_new();
108 $self->config(@Config);
109 $self->config(@_);
110 bless $self, $class;
111}
112
113sub 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
220sub 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
2481;