line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Encode::Encoding; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Base class for classes which implement encodings |
4
|
35
|
|
|
35
|
|
11093
|
use strict; |
|
35
|
|
|
|
|
80
|
|
|
35
|
|
|
|
|
967
|
|
5
|
35
|
|
|
35
|
|
186
|
use warnings; |
|
35
|
|
|
|
|
66
|
|
|
35
|
|
|
|
|
2709
|
|
6
|
|
|
|
|
|
|
our $VERSION = do { my @r = ( q$Revision: 2.8 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our @CARP_NOT = qw(Encode Encode::Encoder); |
9
|
|
|
|
|
|
|
|
10
|
35
|
|
|
35
|
|
272
|
use Carp (); |
|
35
|
|
|
|
|
73
|
|
|
35
|
|
|
|
|
593
|
|
11
|
35
|
|
|
35
|
|
166
|
use Encode (); |
|
35
|
|
|
|
|
68
|
|
|
35
|
|
|
|
|
638
|
|
12
|
35
|
|
|
35
|
|
167
|
use Encode::MIME::Name; |
|
35
|
|
|
|
|
65
|
|
|
35
|
|
|
|
|
1070
|
|
13
|
|
|
|
|
|
|
|
14
|
35
|
|
|
35
|
|
193
|
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; |
|
35
|
|
|
|
|
61
|
|
|
35
|
|
|
|
|
13060
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub Define { |
17
|
28
|
|
|
28
|
0
|
152
|
my $obj = shift; |
18
|
28
|
|
|
|
|
590
|
my $canonical = shift; |
19
|
28
|
50
|
|
|
|
170
|
$obj = bless { Name => $canonical }, $obj unless ref $obj; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# warn "$canonical => $obj\n"; |
22
|
28
|
|
|
|
|
146
|
Encode::define_encoding( $obj, $canonical, @_ ); |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
589
|
|
|
589
|
1
|
104843
|
sub name { return shift->{'Name'} } |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub mime_name { |
28
|
25
|
|
|
25
|
1
|
186
|
return Encode::MIME::Name::get_mime_name(shift->name); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub renew { |
32
|
18
|
|
|
18
|
1
|
39
|
my $self = shift; |
33
|
18
|
|
|
|
|
113
|
my $clone = bless {%$self} => ref($self); |
34
|
18
|
|
|
|
|
55
|
$clone->{renewed}++; # so the caller can see it |
35
|
18
|
|
|
|
|
31
|
DEBUG and warn $clone->{renewed}; |
36
|
18
|
|
|
|
|
87
|
return $clone; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
30224
|
|
100
|
30224
|
1
|
176498
|
sub renewed { return $_[0]->{renewed} || 0 } |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
*new_sequence = \&renew; |
42
|
|
|
|
|
|
|
|
43
|
8
|
|
|
8
|
1
|
62
|
sub needs_lines { 0 } |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub perlio_ok { |
46
|
8
|
50
|
|
8
|
1
|
16
|
return eval { require PerlIO::encoding } ? 1 : 0; |
|
8
|
|
|
|
|
76
|
|
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# (Temporary|legacy) methods |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
0
|
0
|
0
|
sub toUnicode { shift->decode(@_) } |
52
|
0
|
|
|
0
|
0
|
0
|
sub fromUnicode { shift->encode(@_) } |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# |
55
|
|
|
|
|
|
|
# Needs to be overloaded or just croak |
56
|
|
|
|
|
|
|
# |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub encode { |
59
|
1
|
|
|
1
|
1
|
2
|
my $obj = shift; |
60
|
1
|
50
|
|
|
|
4
|
my $class = ref($obj) ? ref($obj) : $obj; |
61
|
1
|
|
|
|
|
308
|
Carp::croak( $class . "->encode() not defined!" ); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub decode { |
65
|
0
|
|
|
0
|
1
|
|
my $obj = shift; |
66
|
0
|
0
|
|
|
|
|
my $class = ref($obj) ? ref($obj) : $obj; |
67
|
0
|
|
|
|
|
|
Carp::croak( $class . "->encode() not defined!" ); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
0
|
|
|
sub DESTROY { } |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |
73
|
|
|
|
|
|
|
__END__ |