~ubuntu-branches/debian/sid/bugzilla/sid

« back to all changes in this revision

Viewing changes to contrib/recode.pl

  • Committer: Bazaar Package Importer
  • Author(s): Raphael Bossek
  • Date: 2008-06-27 22:34:34 UTC
  • mfrom: (1.1.7 upstream)
  • Revision ID: james.westby@ubuntu.com-20080627223434-0ib57vstn43bb4a3
Tags: 3.0.4.1-1
* Update of French, Russian and German translations. (closes: #488251)
* Added Bulgarian and Belarusian translations.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#!/usr/bin/perl -w
2
 
# -*- Mode: perl; indent-tabs-mode: nil -*-
3
 
#
4
 
# The contents of this file are subject to the Mozilla Public
5
 
# License Version 1.1 (the "License"); you may not use this file
6
 
# except in compliance with the License. You may obtain a copy of
7
 
# the License at http://www.mozilla.org/MPL/
8
 
#
9
 
# Software distributed under the License is distributed on an "AS
10
 
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
11
 
# implied. See the License for the specific language governing
12
 
# rights and limitations under the License.
13
 
#
14
 
# The Original Code is the Bugzilla Bug Tracking System.
15
 
#
16
 
# The Initial Developer of the Original Code is Everything Solved.
17
 
# Portions created by Everything Solved are Copyright (C) 2006
18
 
# Everything Solved. All Rights Reserved.
19
 
#
20
 
# Contributor(s): Max Kanat-Alexander <mkanat@bugzilla.org>
21
 
 
22
 
use strict;
23
 
# Allow the script to be run from contrib or as contrib/recode.pl
24
 
use lib '..';
25
 
 
26
 
use Bugzilla;
27
 
use Bugzilla::Constants;
28
 
 
29
 
use Digest::MD5 qw(md5_base64);
30
 
use Encode qw(encode decode resolve_alias is_utf8);
31
 
use Encode::Guess;
32
 
use Getopt::Long;
33
 
use Pod::Usage;
34
 
 
35
 
#############
36
 
# Constants #
37
 
#############
38
 
 
39
 
use constant IGNORE_ENCODINGS => qw(utf8 ascii iso-8859-1);
40
 
 
41
 
use constant MAX_STRING_LEN => 25;
42
 
 
43
 
# For certain tables, we can't automatically determine their Primary Key.
44
 
# So, we specify it here as a string.
45
 
use constant SPECIAL_KEYS => {
46
 
    bugs_activity     => 'bug_id,bug_when,fieldid',
47
 
    profile_setting   => 'user_id,setting_name',
48
 
    profiles_activity => 'userid,profiles_when,fieldid',
49
 
    setting_value     => 'name,value',
50
 
    # longdescs didn't used to have a PK, before 2.20.
51
 
    longdescs         => 'bug_id,bug_when',
52
 
    # The 2.16 versions table lacked a PK
53
 
    versions          => 'product_id,value',
54
 
    # These are all for earlier versions of Bugzilla. On a modern
55
 
    # version of Bugzilla, this script will ignore these (thanks to
56
 
    # code further down).
57
 
    components        => 'program,value',
58
 
    products          => 'product',
59
 
};
60
 
 
61
 
###############
62
 
# Subroutines #
63
 
###############
64
 
 
65
 
# "truncate" is a file operation in perl, so we can't use that name.
66
 
sub trunc {
67
 
    my ($str) = @_;
68
 
    my $truncated = substr($str, 0, MAX_STRING_LEN);
69
 
    if (length($truncated) ne length($str)) {
70
 
        $truncated .= '...';
71
 
    }
72
 
    return $truncated;
73
 
}
74
 
 
75
 
sub do_guess {
76
 
    my ($data) = @_;
77
 
 
78
 
    my $encoding = detect($data);
79
 
    $encoding = resolve_alias($encoding) if $encoding;
80
 
 
81
 
    # Encode::Detect is bad at detecting certain charsets, but Encode::Guess
82
 
    # is better at them. Here's the details:
83
 
 
84
 
    # shiftjis, big5-eten, euc-kr, and euc-jp: (Encode::Detect
85
 
    # tends to accidentally mis-detect UTF-8 strings as being
86
 
    # these encodings.)
87
 
    my @utf8_accidental = qw(shiftjis big5-eten euc-kr euc-jp);
88
 
    if ($encoding && grep($_ eq $encoding, @utf8_accidental)) {
89
 
        $encoding = undef;
90
 
        my $decoder = guess_encoding($data, @utf8_accidental);
91
 
        $encoding = $decoder->name if ref $decoder;
92
 
    }
93
 
 
94
 
    # Encode::Detect sometimes mis-detects various ISO encodings as iso-8859-8,
95
 
    # but Encode::Guess can usually tell which one it is.
96
 
    if ($encoding && $encoding eq 'iso-8859-8') {
97
 
        my $decoded_as = guess_iso($data, 'iso-8859-8', 
98
 
            # These are ordered this way because it gives the most 
99
 
            # accurate results.
100
 
            qw(iso-8859-7 iso-8859-2));
101
 
        $encoding = $decoded_as if $decoded_as;
102
 
    }
103
 
 
104
 
    return $encoding;
105
 
}
106
 
 
107
 
# A helper for do_guess.
108
 
sub guess_iso {
109
 
    my ($data, $versus, @isos) = @_;
110
 
 
111
 
    my $encoding;
112
 
    foreach my $iso (@isos) {
113
 
        my $decoder = guess_encoding($data, ($iso, $versus));
114
 
        if (ref $decoder) {
115
 
            $encoding = $decoder->name if ref $decoder;
116
 
            last;
117
 
        }
118
 
    }
119
 
    return $encoding;
120
 
}
121
 
 
122
 
sub is_valid_utf8 {
123
 
    my ($str) = @_;
124
 
    Encode::_utf8_on($str);
125
 
    return is_utf8($str, 1);
126
 
}
127
 
 
128
 
###############
129
 
# Main Script #
130
 
###############
131
 
 
132
 
my %switch;
133
 
GetOptions(\%switch, 'dry-run', 'guess', 'charset=s', 'show-failures',
134
 
                     'overrides=s', 'help|h');
135
 
 
136
 
pod2usage({ -verbose => 1 }) if $switch{'help'};
137
 
 
138
 
# You have to specify at least one of these switches.
139
 
pod2usage({ -verbose => 0 }) if (!$switch{'charset'} && !$switch{'guess'});
140
 
 
141
 
if (exists $switch{'charset'}) {
142
 
    $switch{'charset'} = resolve_alias($switch{'charset'})
143
 
        || die "'$switch{charset}' is not a valid charset.";
144
 
}
145
 
 
146
 
if ($switch{'guess'}) {
147
 
    # Encode::Detect::Detector doesn't seem to return a true value.
148
 
    # So we have to check if we can run detect.
149
 
    if (!eval { require Encode::Detect::Detector }) {
150
 
        my $root = ROOT_USER;
151
 
        print STDERR <<EOT;
152
 
Using --guess requires that Encode::Detect be installed. To install
153
 
Encode::Detect, first download it from:
154
 
 
155
 
  http://search.cpan.org/dist/Encode-Detect/
156
 
 
157
 
Then, unpack it into its own directory and run the following commands
158
 
in that directory, as $root:
159
 
 
160
 
  ./Build.PL
161
 
  ./Build
162
 
  ./Build install
163
 
 
164
 
EOT
165
 
        exit;
166
 
    }
167
 
 
168
 
    import Encode::Detect::Detector qw(detect);
169
 
}
170
 
 
171
 
my %overrides;
172
 
if (exists $switch{'overrides'}) {
173
 
    my $file = new IO::File($switch{'overrides'}, 'r') 
174
 
        || die "$switch{overrides}: $!";
175
 
    my @lines = $file->getlines();
176
 
    $file->close();
177
 
    foreach my $line (@lines) {
178
 
        chomp($line);
179
 
        my ($digest, $encoding) = split(' ', $line);
180
 
        $overrides{$digest} = $encoding;
181
 
    }
182
 
}
183
 
 
184
 
my $dbh = Bugzilla->dbh;
185
 
 
186
 
if ($dbh->isa('Bugzilla::DB::Mysql')) {
187
 
    # Get the actual current encoding of the DB.
188
 
    my $collation_data = $dbh->selectrow_arrayref(
189
 
        "SHOW VARIABLES LIKE 'character_set_database'");
190
 
    my $db_charset = $collation_data->[1];
191
 
    # Set our connection encoding to *that* encoding, so that MySQL
192
 
    # correctly accepts our changes.
193
 
    $dbh->do("SET NAMES $db_charset");
194
 
    # Make the database give us raw bytes.
195
 
    $dbh->do('SET character_set_results = NULL')
196
 
}
197
 
 
198
 
$dbh->begin_work;
199
 
 
200
 
foreach my $table ($dbh->bz_table_list_real) {
201
 
    my @columns = $dbh->bz_table_columns($table);
202
 
 
203
 
    my $pk = SPECIAL_KEYS->{$table};
204
 
    if ($pk) {
205
 
        # Assure that we're on a version of Bugzilla where those keys
206
 
        # actually exist.
207
 
        foreach my $column (split ',', $pk) {
208
 
            $pk = undef if !$dbh->bz_column_info($table, $column);
209
 
        }
210
 
    }
211
 
 
212
 
    # Figure out the primary key.
213
 
    foreach my $column (@columns) {
214
 
        my $def = $dbh->bz_column_info($table, $column);
215
 
        $pk = $column if $def->{PRIMARYKEY};
216
 
    }
217
 
    # If there's no PK, it's defined by a UNIQUE index.
218
 
    if (!$pk) {
219
 
        foreach my $column (@columns) {
220
 
            my $index = $dbh->bz_index_info($table, "${table}_${column}_idx");
221
 
            if ($index && ref($index) eq 'HASH') {
222
 
                $pk = join(',', @{$index->{FIELDS}}) 
223
 
                    if $index->{TYPE} eq 'UNIQUE';
224
 
            }
225
 
        }
226
 
    }
227
 
 
228
 
    foreach my $column (@columns) {
229
 
        my $def = $dbh->bz_column_info($table, $column);
230
 
        # If this is a text column, it may need work.
231
 
        if ($def->{TYPE} =~ /text|char/i) {
232
 
            # If there's still no PK, we're upgrading from 2.14 or earlier.
233
 
            # We can't reliably determine the PK (or at least, I don't want to
234
 
            # maintain code to record what the PK was at all points in history).
235
 
            # So instead we just use the field itself.
236
 
            $pk = $column if !$pk;
237
 
 
238
 
            print "Converting $table.$column...\n";
239
 
            my $sth = $dbh->prepare("SELECT $column, $pk FROM $table 
240
 
                                      WHERE $column IS NOT NULL
241
 
                                            AND $column != ''");
242
 
 
243
 
            my @pk_array = map {"$_ = ?"} split(',', $pk);
244
 
            my $pk_where = join(' AND ', @pk_array);
245
 
            my $update_sth = $dbh->prepare(
246
 
                "UPDATE $table SET $column = ? WHERE $pk_where");
247
 
 
248
 
            $sth->execute();
249
 
 
250
 
            while (my @result = $sth->fetchrow_array) {
251
 
                my $data = shift @result;
252
 
                my $digest = md5_base64($data);
253
 
 
254
 
                my @primary_keys = reverse split(',', $pk);
255
 
                # We copy the array so that we can pop things from it without
256
 
                # affecting the original.
257
 
                my @pk_data = @result;
258
 
                my $pk_line = join (', ',
259
 
                    map { "$_ = " . pop @pk_data } @primary_keys);
260
 
 
261
 
                my $encoding;
262
 
                if ($switch{'guess'}) {
263
 
                    $encoding = do_guess($data);
264
 
 
265
 
                    # We only show failures if they don't appear to be
266
 
                    # ASCII.
267
 
                    if ($switch{'show-failures'} && !$encoding
268
 
                        && !is_valid_utf8($data)) 
269
 
                    {
270
 
                        my $truncated = trunc($data);
271
 
                        print "Row: [$pk_line]\n",
272
 
                              "Failed to guess: Key: $digest",
273
 
                              " DATA: $truncated\n";
274
 
                    }
275
 
 
276
 
                    # If we fail a guess, and the data is valid UTF-8,
277
 
                    # just assume we failed because it's UTF-8.
278
 
                    next if is_valid_utf8($data);
279
 
                }
280
 
 
281
 
                # If we couldn't detect the charset (or were instructed
282
 
                # not to try), we fall back to --charset. If there's no 
283
 
                # fallback, we just do nothing.
284
 
                if (!$encoding && $switch{'charset'}) {
285
 
                    $encoding = $switch{'charset'};
286
 
                }
287
 
 
288
 
                $encoding = $overrides{$digest} if $overrides{$digest};
289
 
 
290
 
                # We only fix it if it's not ASCII or UTF-8 already.
291
 
                if ($encoding && !grep($_ eq $encoding, IGNORE_ENCODINGS)) {
292
 
                    my $decoded = encode('utf8', decode($encoding, $data));
293
 
                    if ($switch{'dry-run'} && $data ne $decoded) {
294
 
                        print "Row:  [$pk_line]\n",
295
 
                              "From: [" . trunc($data) . "] Key: $digest\n",
296
 
                              "To:   [" . trunc($decoded) . "]",
297
 
                              " Encoding : $encoding\n";
298
 
                    }
299
 
                    else {
300
 
                        $update_sth->execute($decoded, @result);
301
 
                    }
302
 
                }
303
 
            } # while (my @result = $sth->fetchrow_array)
304
 
        } # if ($column->{TYPE} =~ /text|char/i)
305
 
    } # foreach my $column (@columns)
306
 
}
307
 
 
308
 
$dbh->commit;
309
 
 
310
 
__END__
311
 
 
312
 
=head1 NAME
313
 
 
314
 
recode.pl - Converts a database from one encoding (or multiple encodings) 
315
 
to UTF-8.
316
 
 
317
 
=head1 SYNOPSIS
318
 
 
319
 
 contrib/recode.pl [--guess [--show-failures]] [--charset=iso-8859-2]
320
 
                   [--overrides=file_name]
321
 
 
322
 
  --dry-run        Don't modify the database.
323
 
 
324
 
  --charset        Primary charset your data is currently in. This can be
325
 
                   optionally omitted if you do --guess.
326
 
 
327
 
  --guess          Try to guess the charset of the data.
328
 
 
329
 
  --show-failures  If we fail to guess, show where we failed.
330
 
 
331
 
  --overrides      Specify a file containing overrides. See --help
332
 
                   for more info.
333
 
 
334
 
  --help           Display detailed help.
335
 
 
336
 
 If you aren't sure what to do, try:
337
 
 
338
 
   contrib/recode.pl --guess --charset=cp1252
339
 
 
340
 
=head1 OPTIONS
341
 
 
342
 
=over
343
 
 
344
 
=item --dry-run
345
 
 
346
 
Don't modify the database, just print out what the conversions will be.
347
 
 
348
 
recode.pl will print out a Key for each item. You can use this in the 
349
 
overrides file, described below.
350
 
 
351
 
=item --guess 
352
 
 
353
 
If your database is in multiple different encodings, specify this switch 
354
 
and recode.pl will do its best to determine the original charset of the data.
355
 
The detection is usually very reliable.
356
 
 
357
 
If recode.pl cannot guess the charset, it will leave the data alone, unless
358
 
you've specified --charset.
359
 
 
360
 
=item --charset=charset-name
361
 
 
362
 
If you do not specify --guess, then your database is converted
363
 
from this character set into the UTF-8.
364
 
 
365
 
If you have specified --guess, recode.pl will use this charset as
366
 
a fallback--when it cannot guess the charset of a particular piece
367
 
of data, it will guess that the data is in this charset and convert
368
 
it from this charset to UTF-8.
369
 
 
370
 
charset-name must be a charset that is known to perl's Encode 
371
 
module. To see a list of available charsets, do: 
372
 
 
373
 
C<perl -MEncode -e 'print join("\n", Encode-E<gt>encodings(":all"))'>
374
 
 
375
 
=item --show-failures
376
 
 
377
 
If --guess fails to guess a charset, print out the data it failed on.
378
 
 
379
 
=item --overrides=file_name
380
 
 
381
 
This is a way of specifying certain encodings to override the encodings of 
382
 
--guess. The file is a series of lines. The line should start with the Key 
383
 
from --dry-run, and then a space, and then the encoding you'd like to use.
384
 
 
385
 
=back