File Coverage

blib/lib/MIME/Charset/UTF.pm
Criterion Covered Total %
statement 24 27 88.8
branch 10 12 83.3
condition 6 6 100.0
subroutine 6 7 85.7
pod 3 3 100.0
total 49 55 89.0


line stmt bran cond sub pod time code
1             #-*- perl -*-
2             #-*- encoding: utf-8 -*-
3              
4             package MIME::Charset::UTF;
5              
6 2     2   7 use strict;
  2         2  
  2         50  
7 2     2   6 use Carp qw(croak);
  2         2  
  2         102  
8 2     2   6 use Encode::Encoding;
  2         2  
  2         41  
9 2     2   6 use vars qw(@ISA $VERSION);
  2         2  
  2         649  
10             @ISA = qw(Encode::Encoding);
11             $VERSION = '1.010';
12              
13             __PACKAGE__->Define('x-utf16auto');
14             __PACKAGE__->Define('x-utf32auto');
15              
16 0     0 1 0 sub perlio_ok { 0 }
17              
18             sub decode {
19 6     6 1 6 my ($self, $octets, $check) = @_;
20              
21 6 100       13 if ($self->name =~ /16/) {
    50          
22 3 100 100     19 if ($octets =~ /\A\xFE\xFF/ or $octets =~ /\A\xFF\xFE/) {
23 2         5 return Encode::find_encoding('UTF-16')->decode($_[1], $_[2]);
24             } else {
25 1         4 return Encode::find_encoding('UTF-16BE')->decode($_[1], $_[2]);
26             }
27             } elsif ($self->name =~ /32/) {
28 3 100 100     29 if ($octets =~ /\A\0\0\xFE\xFF/ or $octets =~ /\A\xFF\xFE\0\0/) {
29 2         5 return Encode::find_encoding('UTF-32')->decode($_[1], $_[2]);
30             } else {
31 1         3 return Encode::find_encoding('UTF-32BE')->decode($_[1], $_[2]);
32             }
33             } else {
34 0         0 croak 'bug in logic. Ask developer';
35             }
36             }
37              
38             sub encode {
39 2     2 1 2 my $self = $_[0];
40              
41 2 100       4 if ($self->name =~ /16/) {
    50          
42 1         8 return Encode::find_encoding('UTF-16')->encode($_[1], $_[2]);
43             } elsif ($self->name =~ /32/) {
44 1         8 return Encode::find_encoding('UTF-32')->encode($_[1], $_[2]);
45             } else {
46 0           croak 'bug in logic. Ask developer';
47             }
48             }