]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/UTF8.pm
default charset to UTF-8 when it isn't defined
[debbugs.git] / Debbugs / UTF8.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::UTF8;
9
10 =head1 NAME
11
12 Debbugs::UTF8 -- Routines for handling conversion of charsets to UTF8
13
14 =head1 SYNOPSIS
15
16 use Debbugs::UTF8;
17
18
19 =head1 DESCRIPTION
20
21 This module contains routines which convert from various different
22 charsets to UTF8.
23
24 =head1 FUNCTIONS
25
26 =cut
27
28 use warnings;
29 use strict;
30 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
31 use base qw(Exporter);
32
33 BEGIN{
34      $VERSION = 1.00;
35      $DEBUG = 0 unless defined $DEBUG;
36
37      %EXPORT_TAGS = (utf8   => [qw(encode_utf8_structure encode_utf8_safely),
38                                 qw(convert_to_utf8 decode_utf8_safely)],
39                     );
40      @EXPORT = (@{$EXPORT_TAGS{utf8}});
41      @EXPORT_OK = ();
42      Exporter::export_ok_tags(keys %EXPORT_TAGS);
43      $EXPORT_TAGS{all} = [@EXPORT_OK];
44 }
45
46 use Carp;
47 $Carp::Verbose = 1;
48
49 use Encode qw(encode_utf8 is_utf8 decode decode_utf8);
50 use Text::Iconv;
51 use Storable qw(dclone);
52
53
54 =head1 UTF-8
55
56 These functions are exported with the :utf8 tag
57
58 =head2 encode_utf8_structure
59
60      %newdata = encode_utf8_structure(%newdata);
61
62 Takes a complex data structure and encodes any strings with is_utf8
63 set into their constituent octets.
64
65 =cut
66
67 our $depth = 0;
68 sub encode_utf8_structure {
69     ++$depth;
70     my @ret;
71     for my $_ (@_) {
72         if (ref($_) eq 'HASH') {
73             push @ret, {encode_utf8_structure(%{$depth == 1 ? dclone($_):$_})};
74         }
75         elsif (ref($_) eq 'ARRAY') {
76             push @ret, [encode_utf8_structure(@{$depth == 1 ? dclone($_):$_})];
77         }
78         elsif (ref($_)) {
79             # we don't know how to handle non hash or non arrays
80             push @ret,$_;
81         }
82         else {
83             push @ret,encode_utf8_safely($_);
84         }
85     }
86     --$depth;
87     return @ret;
88 }
89
90 =head2 encode_utf8_safely
91
92      $octets = encode_utf8_safely($string);
93
94 Given a $string, returns the octet equivalent of $string if $string is
95 in perl's internal encoding; otherwise returns $string.
96
97 Silently returns REFs without encoding them. [If you want to deeply
98 encode REFs, see encode_utf8_structure.]
99
100 =cut
101
102
103 sub encode_utf8_safely{
104     my @ret;
105     for my $r (@_) {
106         if (not ref($r) and is_utf8($r)) {
107             $r = encode_utf8($r);
108         }
109         push @ret,$r;
110     }
111     return wantarray ? @ret : (@_ > 1 ? @ret : $ret[0]);
112 }
113
114 =head2 decode_utf8_safely
115
116      $string = decode_utf8_safely($octets);
117
118 Given $octets in UTF8, returns the perl-internal equivalent of $octets
119 if $octets does not have is_utf8 set; otherwise returns $octets.
120
121 Silently returns REFs without encoding them.
122
123 =cut
124
125
126 sub decode_utf8_safely{
127     my @ret;
128     for my $r (@_) {
129         if (not ref($r) and not is_utf8($r)) {
130             $r = decode_utf8($r);
131         }
132         push @ret, $r;
133     }
134     return wantarray ? @ret : (@_ > 1 ? @ret : $ret[0]);
135 }
136
137
138
139
140 =head2 convert_to_utf8
141
142     $utf8 = convert_to_utf8("text","charset");
143
144 =cut
145
146 our %iconv_converters;
147
148 sub convert_to_utf8 {
149     my ($data,$charset) = @_;
150     if (is_utf8($data)) {
151         cluck("utf8 flag is set when calling convert_to_utf8");
152         return $data;
153     }
154     $charset = uc($charset//'UTF-8');
155     if ($charset eq 'RAW') {
156         croak("Charset must not be raw when calling convert_to_utf8");
157     }
158     if (not defined $iconv_converters{$charset}) {
159         eval {
160             $iconv_converters{$charset} = Text::Iconv->new($charset,"UTF-8") or
161                 die "Unable to create converter for '$charset'";
162         };
163         if ($@) {
164             warn $@;
165             # We weren't able to create the converter, so use Encode
166             # instead
167             return __fallback_convert_to_utf8($data,$charset);
168         }
169     }
170     if (not defined $iconv_converters{$charset}) {
171         warn "The converter for $charset wasn't created properly somehow!";
172         return __fallback_convert_to_utf8($data,$charset);
173     }
174     my $converted_data = $iconv_converters{$charset}->convert($data);
175     # if the conversion failed, retval will be undefined or perhaps
176     # -1.
177     my $retval = $iconv_converters{$charset}->retval();
178     if (not defined $retval or
179         $retval < 0
180        ) {
181         warn "failed to convert to utf8";
182         # Fallback to encode, which will probably also fail.
183         return __fallback_convert_to_utf8($data,$charset);
184     }
185     return decode("UTF-8",$converted_data);
186 }
187
188 # this returns data in perl's internal encoding
189 sub __fallback_convert_to_utf8 {
190      my ($data, $charset) = @_;
191      # raw data just gets returned (that's the charset WordDecorder
192      # uses when it doesn't know what to do)
193      return $data if $charset eq 'raw';
194      if (not defined $charset and not is_utf8($data)) {
195          warn ("Undefined charset, and string '$data' is not in perl's internal encoding");
196          return $data;
197      }
198      # lets assume everything that doesn't have a charset is utf8
199      $charset //= 'utf8';
200      my $result;
201      eval {
202          $result = decode($charset,$data);
203      };
204      if ($@) {
205           warn "Unable to decode charset; '$charset' and '$data': $@";
206           return $data;
207      }
208      return $result;
209 }
210
211
212
213 1;
214
215 __END__