File Coverage

blib/lib/Encode/Encoding.pm
Criterion Covered Total %
statement 36 41 87.8
branch 3 8 37.5
condition 2 2 100.0
subroutine 14 18 77.7
pod 8 11 72.7
total 63 80 78.7


line stmt bran cond sub pod time code
1             package Encode::Encoding;
2              
3             # Base class for classes which implement encodings
4 41     41   16428 use strict;
  41         829  
  41         1132  
5 41     41   1275 use warnings;
  41         89  
  41         3478  
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 41     41   273 use Carp ();
  41         911  
  41         693  
11 41     41   204 use Encode ();
  41         86  
  41         704  
12 41     41   262 use Encode::MIME::Name;
  41         110  
  41         1391  
13              
14 41     41   292 use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
  41         93  
  41         18489  
15              
16             sub Define {
17 28     28 0 92 my $obj = shift;
18 28         62 my $canonical = shift;
19 28 50       223 $obj = bless { Name => $canonical }, $obj unless ref $obj;
20              
21             # warn "$canonical => $obj\n";
22 28         147 Encode::define_encoding( $obj, $canonical, @_ );
23             }
24              
25 590     590 1 101999 sub name { return shift->{'Name'} }
26              
27             sub mime_name {
28 25     25 1 243 return Encode::MIME::Name::get_mime_name(shift->name);
29             }
30              
31             sub renew {
32 24     24 1 64 my $self = shift;
33 24         162 my $clone = bless {%$self} => ref($self);
34 24         73 $clone->{renewed}++; # so the caller can see it
35 24         37 DEBUG and warn $clone->{renewed};
36 24         113 return $clone;
37             }
38              
39 30305   100 30305 1 200755 sub renewed { return $_[0]->{renewed} || 0 }
40              
41             *new_sequence = \&renew;
42              
43 14     14 1 98 sub needs_lines { 0 }
44              
45             sub perlio_ok {
46 8 50   8 1 24 return eval { require PerlIO::encoding } ? 1 : 0;
  8         84  
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 3 my $obj = shift;
60 1 50       5 my $class = ref($obj) ? ref($obj) : $obj;
61 1         334 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__