File Coverage

blib/lib/Locale/Recode.pm
Criterion Covered Total %
statement 36 60 60.0
branch 9 20 45.0
condition 2 6 33.3
subroutine 5 7 71.4
pod 4 6 66.6
total 56 99 56.5


line stmt bran cond sub pod time code
1             #! /bin/false
2              
3             # vim: set autoindent shiftwidth=4 tabstop=4:
4              
5             # Portable character conversion for Perl.
6             # Copyright (C) 2002-2017 Guido Flohr ,
7             # all rights reserved.
8              
9             # This program is free software: you can redistribute it and/or modify
10             # it under the terms of the GNU General Public License as published by
11             # the Free Software Foundation; either version 3 of the License, or
12             # (at your option) any later version.
13              
14             # This program is distributed in the hope that it will be useful,
15             # but WITHOUT ANY WARRANTY; without even the implied warranty of
16             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17             # GNU General Public License for more details.
18              
19             # You should have received a copy of the GNU General Public License
20             # along with this program. If not, see .
21              
22             package Locale::Recode;
23              
24 161     161   846548 use strict;
  161         1127  
  161         101855  
25              
26             require Locale::Recode::_Conversions;
27              
28             my $loaded = {};
29             my $has_encode;
30              
31             sub new
32             {
33 549   33 549 0 627359 my $class = ref($_[0]) || $_[0];
34 549         1143 shift;
35 549         2350 my %args = @_;
36              
37 549         1494 my $self = bless {}, $class;
38              
39 549         1851 my ($from_codeset, $to_codeset) = @args{qw (from to)};
40            
41 549 50 33     2587 unless ($from_codeset && $to_codeset) {
42 0         0 require Carp;
43 0         0 Carp::croak (<
44             Usage: $class->new (from => FROM_CODESET, to => TO_CODESET);
45             EOF
46             }
47              
48             # Find a conversion path.
49 549         2982 my $path = Locale::Recode::_Conversions->findPath ($from_codeset,
50             $to_codeset);
51 549 50       1492 unless ($path) {
52 0         0 $self->{__error} = 'EINVAL';
53 0         0 return $self;
54             }
55              
56 549         1182 my @conversions = ();
57 549         1381 foreach (@$path) {
58 549         1447 my ($module, $from, $to) = @$_;
59            
60 549 100       1543 unless ($loaded->{$module}) {
61 139         8032 eval "require Locale::RecodeData::$module";
62 139 50       1018 if ($@) {
63 0         0 $self->{__error} = $@;
64 0         0 return $self;
65             }
66            
67 139         610 $loaded->{$module} = 1;
68             }
69            
70 549         1466 my $module_name = "Locale::RecodeData::$module";
71 549         948 my $method = 'new';
72 549         3209 my $object = $module_name->$method (from => $from,
73             to => $to);
74            
75 549         1858 push @conversions, $object;
76             }
77              
78 549         1886 $self->{__conversions} = \@conversions;
79            
80 549         2237 return $self;
81             }
82              
83             sub resolveAlias
84             {
85 4     4 0 10 my ($class, $alias) = @_;
86              
87 4         20 return Locale::Recode::_Conversions->resolveAlias ($alias);
88             }
89              
90             sub getSupported
91             {
92 0     0 1 0 return [ Locale::Recode::_Conversions->listSupported ];
93             }
94              
95             sub getCharsets
96             {
97 0     0 1 0 my $self = shift;
98 0         0 my %all = map { $_ => 1 } @{&getSupported};
  0         0  
  0         0  
99              
100 0         0 require Locale::Recode::_Aliases;
101              
102 0         0 my $conversions = Locale::Recode::_Conversions->listSupported;
103 0         0 foreach my $charset (keys %{Locale::Recode::_Aliases::ALIASES()}) {
  0         0  
104 0         0 my $mime_name = $self->resolveAlias ($charset);
105 0 0       0 next unless exists $all{$mime_name};
106 0         0 $all{$charset} = 1;
107             }
108            
109 0         0 return [ keys %all ];
110             }
111              
112             sub recode
113             {
114 199610     199610 1 1594951 my $self = $_[0];
115              
116 199610 50       370405 return if $self->{__error};
117              
118 199610 50       326227 return 1 unless defined $_[1];
119              
120 199610         255112 my $chain = $self->{__conversions};
121            
122 199610         299197 foreach my $module (@$chain) {
123 199610         366598 my $success = $module->_recode ($_[1]);
124            
125 199610 50       395559 unless ($success) {
126 0         0 $self->{__error} = $module->_getError;
127 0         0 return;
128             }
129             }
130              
131 199610         312209 return 1;
132             }
133              
134             sub getError
135             {
136 412     412 1 1987 my $self = shift;
137 412 50       2765 my $error = $self->{__error} or return;
138              
139 0 0         if ('EINVAL' eq $error) {
140 0           return 'Invalid conversion';
141             } else {
142 0           return $error;
143             }
144             }
145              
146             1;
147              
148             __END__