Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^4: Why does Encode::Repair only correctly fix one of these two tandem characters?

by Jim (Curate)
on Aug 09, 2014 at 21:04 UTC ( [id://1096869]=note: print w/replies, xml ) Need Help??


in reply to Re^3: Why does Encode::Repair only correctly fix one of these two tandem characters?
in thread Why does Encode::Repair only correctly fix one of these two tandem characters?

I’m guessing you’ve got an irreversible mojibake situation that will require custom code or lookup tables.

In the specific case of the corpus of documents I need to repair (which, by the way, is a very common case), all mojibake are the characters in the Windows-1252 character encoding in the range from 80 through 9F. So I can repair the damaged characters with a small lookup table and a regular expression pattern that matches the substrings that are the damaged characters.

Here's the script I'll use to repair the many text files with the UTF-8/Windows-1252 character encoding damage in them:

#!perl use strict; use warnings; use open qw( :encoding(UTF-8) :std ); use English qw( -no_match_vars ); use File::Glob qw( bsd_glob ); @ARGV or die "Usage: perl $PROGRAM_NAME file ...\n"; local @ARGV = map { bsd_glob($ARG) } @ARGV; local $INPLACE_EDIT = '.bak'; # See http://www.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP +1252.TXT my %mojibake_replace = ( "\x{00E2}\x{201A}\x{00AC}" => "\x{20AC}", # 0x80 EURO SIGN "\x{00C2}\x{0081}" => "\x{0081}", # 0x81 UNDEFINED "\x{00E2}\x{20AC}\x{0161}" => "\x{201A}", # 0x82 SINGLE LOW-9 QUOT +ATION MARK "\x{00C6}\x{2019}" => "\x{0192}", # 0x83 LATIN SMALL LETTE +R F WITH HOOK "\x{00E2}\x{20AC}\x{017E}" => "\x{201E}", # 0x84 DOUBLE LOW-9 QUOT +ATION MARK "\x{00E2}\x{20AC}\x{00A6}" => "\x{2026}", # 0x85 HORIZONTAL ELLIPS +IS "\x{00E2}\x{20AC}\x{00A0}" => "\x{2020}", # 0x86 DAGGER "\x{00E2}\x{20AC}\x{00A1}" => "\x{2021}", # 0x87 DOUBLE DAGGER "\x{00CB}\x{2020}" => "\x{02C6}", # 0x88 MODIFIER LETTER C +IRCUMFLEX ACCENT "\x{00E2}\x{20AC}\x{00B0}" => "\x{2030}", # 0x89 PER MILLE SIGN "\x{00C5}\x{00A0}" => "\x{0160}", # 0x8A LATIN CAPITAL LET +TER S WITH CARON "\x{00E2}\x{20AC}\x{00B9}" => "\x{2039}", # 0x8B SINGLE LEFT-POINT +ING ANGLE QUOTATION MARK "\x{00C5}\x{2019}" => "\x{0152}", # 0x8C LATIN CAPITAL LIG +ATURE OE "\x{00C2}\x{008D}" => "\x{008D}", # 0x8D UNDEFINED "\x{00C5}\x{00BD}" => "\x{017D}", # 0x8E LATIN CAPITAL LET +TER Z WITH CARON "\x{00C2}\x{008F}" => "\x{008F}", # 0x8F UNDEFINED "\x{00C2}\x{0090}" => "\x{0090}", # 0x90 UNDEFINED "\x{00E2}\x{20AC}\x{02DC}" => "\x{2018}", # 0x91 LEFT SINGLE QUOTA +TION MARK "\x{00E2}\x{20AC}\x{2122}" => "\x{2019}", # 0x92 RIGHT SINGLE QUOT +ATION MARK "\x{00E2}\x{20AC}\x{0153}" => "\x{201C}", # 0x93 LEFT DOUBLE QUOTA +TION MARK "\x{00E2}\x{20AC}\x{009D}" => "\x{201D}", # 0x94 RIGHT DOUBLE QUOT +ATION MARK "\x{00E2}\x{20AC}\x{00A2}" => "\x{2022}", # 0x95 BULLET "\x{00E2}\x{20AC}\x{201C}" => "\x{2013}", # 0x96 EN DASH "\x{00E2}\x{20AC}\x{201D}" => "\x{2014}", # 0x97 EM DASH "\x{00CB}\x{0153}" => "\x{02DC}", # 0x98 SMALL TILDE "\x{00E2}\x{201E}\x{00A2}" => "\x{2122}", # 0x99 TRADE MARK SIGN "\x{00C5}\x{00A1}" => "\x{0161}", # 0x9A LATIN SMALL LETTE +R S WITH CARON "\x{00E2}\x{20AC}\x{00BA}" => "\x{203A}", # 0x9B SINGLE RIGHT-POIN +TING ANGLE QUOTATION MARK "\x{00C5}\x{201C}" => "\x{0153}", # 0x9C LATIN SMALL LIGAT +URE OE "\x{00C2}\x{009D}" => "\x{009D}", # 0x9D UNDEFINED "\x{00C5}\x{00BE}" => "\x{017E}", # 0x9E LATIN SMALL LETTE +R Z WITH CARON "\x{00C5}\x{00B8}" => "\x{0178}", # 0x9F LATIN CAPITAL LET +TER Y WITH DIAERESIS ); my $mojibake_regex = qr{ ( \x{00C2}[\x{0081}\x{008D}\x{008F}\x{0090}\x{009D}] | \x{00C5}[\x{00A0}\x{00A1}\x{00B8}\x{00BD}\x{00BE}\x{2019}\x{201C}] | \x{00C6}\x{2019} | \x{00CB}[\x{0153}\x{2020}] | \x{00E2}\x{20AC}[\x{009D}\x{00A0}\x{00A1}\x{00A2}\x{00A6}\x{00B0}\ +x{00B9}\x{00BA}\x{0153}\x{0161}\x{017E}\x{02DC}\x{201C}\x{201D}\x{212 +2}] | \x{00E2}\x{201A}\x{00AC} | \x{00E2}\x{201E}\x{00A2} ) }x; while (<ARGV>) { s/$mojibake_regex/$mojibake_replace{$1}/g; print; } exit 0;

(As always, constructive criticism and earnest suggestions for improvement are welcome and appreciated.)

Don”t know if this particular case is already covered somewhere.

I'm a little surprised by this blind spot in Encode::Repair because, in my experience, this is by far the most ubiquitous kind of mojibake in Latin script text (i.e., text in Western European languages). In fairness to its author, moritz, the documentation includes the following Development section:

  Development
      The source code is stored in a public git repository at
      <http://github.com/moritz/Encode-Repair>. If you find any bugs, please
      used the issue tracker linked from this site.

      If you find a case of messed-up encodings that can be repaired
      deterministically and that's not covered by this module, please contact
      the author, providing a hex dump of both input and output, and as much
      information of the encoding and decoding process as you have.

      Patches are also very welcome.

Replies are listed 'Best First'.
Re^5: Why does Encode::Repair only correctly fix one of these two tandem characters?
by ikegami (Patriarch) on Aug 11, 2014 at 02:02 UTC
    The following tool takes out having to do all the hard, error-prone work.
    use strict; use warnings; use Encode qw( encode decode ); { my @charset = grep $_ ne "\x{FFFD}", map decode('cp1252', chr($_)), 0x00..0xFF; my %map; for my $dec (@charset) { my $enc = encode 'UTF-8', decode 'cp1252', encode 'UTF-8', $dec; push @{ $map{$enc} }, $dec; } for (values(%map)) { warn(sprintf("Ambiguous: %v04X\n", join '', @$_)) if @$_ > 1; $_ = $_->[0]; } my $pat = join '|', map quotemeta, sort { length($b) <=> length($a) || $a cmp $b } keys %map; my $re = qr/$pat/; while (<>) { s/\G(?:($re)|(.))/ if ($1) { $map{$1} } else { die("Unrecognized sequence starting at pos", $-[2]); } /seg; } }

    It also finds that you have a problem. You can't tell the difference between the following cp1252 characters after they've gone through your encoding-decoding gauntlet:

    • U+00C1 LATIN CAPITAL LETTER A WITH ACUTE
    • U+00CD LATIN CAPITAL LETTER I WITH ACUTE
    • U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS
    • U+00D0 LATIN CAPITAL LETTER ETH
    • U+00DD LATIN CAPITAL LETTER Y WITH ACUTE

    Verification:

    $ perl -MEncode -E' say sprintf "%v02X", encode "UTF-8", decode "cp1252", encode "UTF-8", chr for 0x00C1, 0x00CD, 0x00CF, 0x00D0, 0x00DD; ' C3.83.EF.BF.BD C3.83.EF.BF.BD C3.83.EF.BF.BD C3.83.EF.BF.BD C3.83.EF.BF.BD

    Note: I didn't have the tool check if one messed up sequence can be a substring of another messed up sequence. The sorting by descending length is there to try to handle that case if it exists. Upd: No such case exists.

Re^5: Why does Encode::Repair only correctly fix one of these two tandem characters?
by ikegami (Patriarch) on Aug 11, 2014 at 01:49 UTC

    The most common garbage from Perl code is mixed UTF-8 and latin-1. It happens when you forgot to specify the output encoding.

    print "\N{LATIN CAPITAL LETTER E WITH ACUTE}"; print "\N{BLACK SPADE SUIT}";

    The first string consists entirely of bytes, so Perl doesn't know you did something wrong. The second string makes no sense, so Perl guesses you meant to encode it using UTF-8. You end up with a mix of code points (effectively latin-1) and UTF-8.

    This is fixed using Encoding::FixLatin

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1096869]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (3)
As of 2024-03-29 14:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found