← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:49 2015

Filename/usr/share/perl5/MARC/Charset/Code.pm
StatementsExecuted 14 statements in 1.78ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1112.23ms3.10msMARC::Charset::Code::::BEGIN@8MARC::Charset::Code::BEGIN@8
11111µs23µsMARC::Charset::Code::::BEGIN@3MARC::Charset::Code::BEGIN@3
1118µs1.84msMARC::Charset::Code::::BEGIN@5MARC::Charset::Code::BEGIN@5
1118µs31µsMARC::Charset::Code::::BEGIN@6MARC::Charset::Code::BEGIN@6
1117µs12µsMARC::Charset::Code::::BEGIN@4MARC::Charset::Code::BEGIN@4
1117µs24µsMARC::Charset::Code::::BEGIN@7MARC::Charset::Code::BEGIN@7
0000s0sMARC::Charset::Code::::char_valueMARC::Charset::Code::char_value
0000s0sMARC::Charset::Code::::charset_nameMARC::Charset::Code::charset_name
0000s0sMARC::Charset::Code::::charset_valueMARC::Charset::Code::charset_value
0000s0sMARC::Charset::Code::::default_charset_groupMARC::Charset::Code::default_charset_group
0000s0sMARC::Charset::Code::::g0_marc_valueMARC::Charset::Code::g0_marc_value
0000s0sMARC::Charset::Code::::get_escapeMARC::Charset::Code::get_escape
0000s0sMARC::Charset::Code::::marc8_hash_codeMARC::Charset::Code::marc8_hash_code
0000s0sMARC::Charset::Code::::marc_valueMARC::Charset::Code::marc_value
0000s0sMARC::Charset::Code::::to_stringMARC::Charset::Code::to_string
0000s0sMARC::Charset::Code::::utf8_hash_codeMARC::Charset::Code::utf8_hash_code
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package MARC::Charset::Code;
2
3223µs235µs
# spent 23µs (11+12) within MARC::Charset::Code::BEGIN@3 which was called: # once (11µs+12µs) by MARC::Charset::Table::BEGIN@43 at line 3
use strict;
# spent 23µs making 1 call to MARC::Charset::Code::BEGIN@3 # spent 12µs making 1 call to strict::import
4222µs218µs
# spent 12µs (7+5) within MARC::Charset::Code::BEGIN@4 which was called: # once (7µs+5µs) by MARC::Charset::Table::BEGIN@43 at line 4
use warnings;
# spent 12µs making 1 call to MARC::Charset::Code::BEGIN@4 # spent 5µs making 1 call to warnings::import
5235µs23.67ms
# spent 1.84ms (8µs+1.83) within MARC::Charset::Code::BEGIN@5 which was called: # once (8µs+1.83ms) by MARC::Charset::Table::BEGIN@43 at line 5
use base qw(Class::Accessor);
# spent 1.84ms making 1 call to MARC::Charset::Code::BEGIN@5 # spent 1.83ms making 1 call to base::import
6224µs254µs
# spent 31µs (8+23) within MARC::Charset::Code::BEGIN@6 which was called: # once (8µs+23µs) by MARC::Charset::Table::BEGIN@43 at line 6
use Carp qw(croak);
# spent 31µs making 1 call to MARC::Charset::Code::BEGIN@6 # spent 23µs making 1 call to Exporter::import
7223µs242µs
# spent 24µs (7+18) within MARC::Charset::Code::BEGIN@7 which was called: # once (7µs+18µs) by MARC::Charset::Table::BEGIN@43 at line 7
use Encode qw(encode_utf8);
# spent 24µs making 1 call to MARC::Charset::Code::BEGIN@7 # spent 18µs making 1 call to Exporter::import
821.64ms23.28ms
# spent 3.10ms (2.23+869µs) within MARC::Charset::Code::BEGIN@8 which was called: # once (2.23ms+869µs) by MARC::Charset::Table::BEGIN@43 at line 8
use MARC::Charset::Constants qw(:all);
# spent 3.10ms making 1 call to MARC::Charset::Code::BEGIN@8 # spent 177µs making 1 call to Exporter::import
9
1015µs1178µsMARC::Charset::Code
# spent 178µs making 1 call to Class::Accessor::mk_accessors
11 ->mk_accessors(qw(marc ucs name charset is_combining alt
12 marc_right_half marc_left_half));
13
14=head1 NAME
15
16MARC::Charset::Code - represents a MARC-8/UTF-8 mapping
17
18=head1 SYNOPSIS
19
20=head1 DESCRIPTION
21
22Each mapping from a MARC-8 value to a UTF-8 value is represented by
23a MARC::Charset::Code object in a MARC::Charset::Table.
24
25=head1 METHODS
26
27=head2 new()
28
29The constructor.
30
31=head2 name()
32
33A descriptive name for the code point.
34
35=head2 marc()
36
37A string representing the MARC-8 bytes codes.
38
39=head2 ucs()
40
41A string representing the UCS code point in hex.
42
43=head2 charset_code()
44
45The MARC-8 character set code.
46
47=head2 is_combining()
48
49Returns true/false to tell if the character is a combining character.
50
51=head2 marc_left_half()
52
53If the character is the right half of a "double diacritic", returns
54a hex string representing the MARC-8 value of the left half.
55
56=head2 marc_right_half()
57
58If the character is the left half of a "double diacritic", returns
59a hex string representing the MARC-8 value of the right half.
60
61=head2 to_string()
62
63A stringified version of the object suitable for pretty printing.
64
65=head2 char_value()
66
67Returns the unicode character. Essentially just a helper around
68ucs().
69
70=cut
71
72sub char_value
73{
74 return chr(hex(shift->ucs()));
75}
76
77=head2 g0_marc_value()
78
79The string representing the MARC-8 encoding
80for lookup.
81
82=cut
83
84sub g0_marc_value
85{
86 my $code = shift;
87 my $marc = $code->marc();
88 if ($code->charset_name eq 'CJK') {
89 return
90 chr(hex(substr($marc,0,2))) .
91 chr(hex(substr($marc,2,2))) .
92 chr(hex(substr($marc,4,2)));
93 } else {
94 return chr(hex($marc));
95 }
96}
97
98=head2 marc_value()
99
100The string representing the MARC-8 encodingA
101for output.
102
103=cut
104
105sub marc_value
106{
107 my $code = shift;
108 my $marc = $code->marc();
109 if ($code->charset_name eq 'CJK') {
110 return
111 chr(hex(substr($marc,0,2))) .
112 chr(hex(substr($marc,2,2))) .
113 chr(hex(substr($marc,4,2)));
114 } else {
115 if ($code->default_charset_group() eq 'G0') {
116 return chr(hex($marc));
117 } else {
118 return chr(hex($marc) + 128);
119 }
120 }
121}
122
123
124=head2 charset_name()
125
126Returns the name of the character set, instead of the code.
127
128=cut
129
130sub charset_name
131{
132 return MARC::Charset::Constants::charset_name(shift->charset_value());
133}
134
135=head2 to_string()
136
137Returns a stringified version of the object.
138
139=cut
140
141sub to_string
142{
143 my $self = shift;
144 my $str =
145 $self->name() . ': ' .
146 'charset_code=' . $self->charset() . ' ' .
147 'marc=' . $self->marc() . ' ' .
148 'ucs=' . $self->ucs() . ' ';
149
150 $str .= ' combining' if $self->is_combining();
151 return $str;
152}
153
154
155=head2 marc8_hash_code()
156
157Returns a hash code for this Code object for looking up the object using
158MARC8. First portion is the character set code and the second is the
159MARC-8 value.
160
161=cut
162
163sub marc8_hash_code
164{
165 my $self = shift;
166 return sprintf('%s:%s', $self->charset_value(), $self->g0_marc_value());
167}
168
169
170=head2 utf8_hash_code()
171
172Returns a hash code for uniquely identifying a Code by it's UCS value.
173
174=cut
175
176sub utf8_hash_code
177{
178 return int(hex(shift->ucs()));
179}
180
181
182=head2 default_charset_group
183
184Returns 'G0' or 'G1' indicating where the character is typicalling used
185in the MARC-8 environment.
186
187=cut
188
189sub default_charset_group
190{
191 my $charset = shift->charset_value();
192
193 return 'G0'
194 if $charset eq ASCII_DEFAULT
195 or $charset eq GREEK_SYMBOLS
196 or $charset eq SUBSCRIPTS
197 or $charset eq SUPERSCRIPTS
198 or $charset eq BASIC_LATIN
199 or $charset eq BASIC_ARABIC
200 or $charset eq BASIC_CYRILLIC
201 or $charset eq BASIC_GREEK
202 or $charset eq BASIC_HEBREW
203 or $charset eq CJK;
204
205 return 'G1';
206}
207
208
209=head2 get_marc8_escape
210
211Returns an escape sequence to move to the Code from another marc-8 character
212set.
213
214=cut
215
216sub get_escape
217{
218 my $charset = shift->charset_value();
219
220 return ESCAPE . $charset
221 if $charset eq ASCII_DEFAULT
222 or $charset eq GREEK_SYMBOLS
223 or $charset eq SUBSCRIPTS
224 or $charset eq SUPERSCRIPTS;
225
226 return ESCAPE . SINGLE_G0_A . $charset
227 if $charset eq ASCII_DEFAULT
228 or $charset eq BASIC_LATIN
229 or $charset eq BASIC_ARABIC
230 or $charset eq BASIC_CYRILLIC
231 or $charset eq BASIC_GREEK
232 or $charset eq BASIC_HEBREW;
233
234 return ESCAPE . SINGLE_G1_A . $charset
235 if $charset eq EXTENDED_ARABIC
236 or $charset eq EXTENDED_LATIN
237 or $charset eq EXTENDED_CYRILLIC;
238
239 return ESCAPE . MULTI_G0_A . CJK
240 if $charset eq CJK;
241}
242
243=head2 charset_value
244
245Returns the charset value, not the hex sequence.
246
247=cut
248
249sub charset_value
250{
251 return chr(hex(shift->charset()));
252}
253
- -
25612µs1;
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.