File Coverage

blib/lib/Encode/Unicode.pm
Criterion Covered Total %
statement 20 20 100.0
branch 1 2 50.0
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 28 29 96.5


line stmt bran cond sub pod time code
1             package Encode::Unicode;
2              
3 11     11   67 use strict;
  11         21  
  11         323  
4 11     11   53 use warnings;
  11         58  
  11         815  
5              
6             our $VERSION = do { my @r = ( q$Revision: 2.16 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
7              
8 11     11   84 use XSLoader;
  11         20  
  11         318  
9             XSLoader::load( __PACKAGE__, $VERSION );
10              
11             #
12             # Object Generator 8 transcoders all at once!
13             #
14              
15 11     11   48 use Encode ();
  11         18  
  11         1837  
16              
17             our %BOM_Unknown = map { $_ => 1 } qw(UTF-16 UTF-32);
18              
19             for my $name (
20             qw(UTF-16 UTF-16BE UTF-16LE
21             UTF-32 UTF-32BE UTF-32LE
22             UCS-2BE UCS-2LE)
23             )
24             {
25             my ( $size, $endian, $ucs2, $mask );
26             $name =~ /^(\w+)-(\d+)(\w*)$/o;
27             if ( $ucs2 = ( $1 eq 'UCS' ) ) {
28             $size = 2;
29             }
30             else {
31             $size = $2 / 8;
32             }
33             $endian = ( $3 eq 'BE' ) ? 'n' : ( $3 eq 'LE' ) ? 'v' : '';
34             $size == 4 and $endian = uc($endian);
35              
36             my $obj = bless {
37             Name => $name,
38             size => $size,
39             endian => $endian,
40             ucs2 => $ucs2,
41             } => __PACKAGE__;
42             Encode::define_encoding($obj, $name);
43             }
44              
45 11     11   67 use parent qw(Encode::Encoding);
  11         17  
  11         86  
46              
47             sub renew {
48 6     6 1 12 my $self = shift;
49 6 50       18 $BOM_Unknown{ $self->name } or return $self;
50 6         34 my $clone = bless {%$self} => ref($self);
51 6         12 $clone->{renewed}++; # so the caller knows it is renewed.
52 6         21 return $clone;
53             }
54              
55             1;
56             __END__