#! /usr/bin/perl # Goal: to unmangle UTF-8 filenames on NSS filesystems which have been # corrupted due to a mismatch in 8-bit codepage settings on server ("cpwrong") # and client ("cpright"). # Based on # convmv 1.10 - converts filenames from one encoding to another # Copyright © 2003-2006 Bjoern JACKE # # This program comes with ABSOLUTELY NO WARRANTY; it may be copied or modified # under the terms of the GNU General Public License version 2 as published by # the Free Software Foundation. # to get a man page: # pod2man --section 1 --center=" " convmv | gzip > convmv.1.gz =head1 NAME convmv - converts filenames from one encoding to another =head1 SYNOPSIS B [B] FILE(S) ... DIRECTORY(S) =head1 OPTIONS =over 4 =item B<-f ENCODING> specify the current encoding of the filename(s) from which should be converted =item B<-t ENCODING> specify the encoding to which the filename(s) should be converted =item B<-i> interactive mode (ask y/n for each action) =item B<-r> recursively go through directories =item B<--nfc> target files will be normalization form C for UTF-8 (Linux etc.) =item B<--nfd> target files will be normalization form D for UTF-8 (OS X etc.). =item B<--qfrom> , B<--qto> be more quiet about the "from" or "to" of a rename (if it screws up your terminal e.g.). This will in fact do nothing else than replace any non-ASCII character (bytewise) with ? and any control character with * on printout, this does not affect rename operation itself. =item B<--exec> command execute the given command. You have to quote the command and #1 will be substituted by the old, #2 by the new filename. Using this option link targets will stay untouched. Example: convmv -f latin1 -t utf-8 -r --exec "echo #1 should be renamed to #2" path/to/files =item B<--list> list all available encodings. To get support for more Chinese or Japanese encodings install the Perl HanExtra or JIS2K Encode packages. =item B<--lowmem> keep memory footprint low by not creating a hash of all files. This disables checking if symlink targets are in subtree. Symlink target pointers will be converted regardlessly. If you convert multiple hundredthousands or millions of files the memory usage of convmv might grow quite high. This option would help you out in that case. =item B<--nosmart> by default convmv will detect if a filename is already UTF8 encoded and will skip this file if conversion from some charset to UTF8 should be performed. C<--nosmart> will also force conversion to UTF-8 for such files, which might result in "double encoded UTF-8" (see section below). =item B<--notest> Needed to actually rename the files. By default convmv will just print what it wants to do. =item B<--replace> if the file to which shall be renamed already exists, it will be overwritten if the other file content is equal. =item B<--unescape> this option will remove this ugly % hex sequences from filenames and turn them into (hopefully) nicer 8-bit characters. After --unescape you might want to do a charset conversion. This sequences like %20 etc. are sometimes produced when downloading via http or ftp. =item B<--upper> , B<--lower> turn filenames into all upper or all lower case. When the file is not ASCII-encoded, convmv expects a charset to be entered via the -f switch. =item B<--dotlessi> care about the dotless i/I issue. A lowercase version of "I" will also be dotless while an uppercase version of "i" will also be dotted. This is an issue for Turkish and Azeri. By the way: The superscript dot of the letter i was added in the Middle Ages to distinguish the letter (in manuscripts) from adjacent vertical strokes in such letters as u, m, and n. J is a variant form of i which emerged at this time and subsequently became a separate letter. =item B<--fromcp ENCODING> =item B<--tocp ENCODING> fix UTF-8 filenames where characters have been mangled due to two conversions involving different codepages. Characters from the "from" encoding (code page) are changed into the UTF-8 characters corresponding to the charachter in the "to" encoding at the same (byte) index. =item B<--help> print a short summary of available options =back =head1 DESCRIPTION B is meant to help convert a single filename, a directory tree and the contained files or a whole filesystem into a different encoding. It just converts the filenames, not the content of the files. A special feature of convmv is that it also takes care of symlinks, also converts the symlink target pointer in case the symlink target is being converted, too. All this comes in very handy when one wants to switch over from old 8-bit locales to UTF-8 locales. It is also possible to convert directories to UTF-8 which are already partly UTF-8 encoded. convmv is able to detect if certain files are UTF-8 encoded and will skip them by default. To turn this smartness off use the C<--nosmart> switch. =head2 Filesystem issues Almost all POSIX filesystems do not care about how filenames are encoded, here are some exceptions: =head3 HFS+ on OS X / Darwin Linux and (most?) other Unix-like operating systems use the so called normalization form C (NFC) for its UTF-8 encoding by default but do not enforce this. Darwin, the base of the Macintosh OS enforces normalization form D (NFD), where a few characters are encoded in a different way. On OS X it's not possible to create NFC UTF-8 filenames because this is prevented at filesystem layer. On HFS+ filenames are internally stored in UTF-16 and when converted back to UTF-8, for the underlying BSD system to be handable, NFD is created. If someone knows why Apple chose to do this, please let me know. I think it was a very bad idea and breaks many things under OS X which expect a normal POSIX conforming system. Anywhere else convmv is able to convert files from NFC to NFD or vice versa which makes interoperability with such systems a lot easier. =head3 JFS If people mount JFS partitions with iocharset=utf8, there is a similar problem, because JFS is designed to store finenames internally in UTF-16, too; that is because Linux' JFS is really JFS2, which was a rewrite of JFS for OS/2. JFS partitions should always be mounted with iocharset=iso8859-1, which is also the default with recent 2.6.6 kernels. If this is not done, JFS does not behave like a POSIX filesystem and it might happen that certain files cannot be created at all, for example filenames in ISO-8859-1 encoding. Only when interoperation with OS/2 is needed iocharset should be set according to your used locale charmap. =head3 NFS4 Despite other POSIX filesystems RFC3530 (NFS 4) mandates UTF-8 but also says: "The nfs4_cs_prep profile does not specify a normalization form. A later revision of this specification may specify a particular normalization form." In other words, if you want to use NFS4 you might find the conversion and normalization features of convmv quite useful. =head3 FAT/VFAT and NTFS NTFS and VFAT (for long filenames) use UTF-16 internally to store filenames. You should not need to convert filenames if you mount one of those filesystems. Use appropriate mount options instead! =head3 Mangled filenames on NSS A fairly common problem with files stored on an NSS (Novell Storage Services) filesystem is that their names have been mangled due to a different code page setting between client and server. To fix this, use C<--fromcp=code_page_setting_on_the_server --tocp=code_page_setting_on_the_client>. =head2 How to undo double UTF-8 (or other) encoded filenames Sometimes it might happen that you "double-encoded" certain filenames, for example the file names already were UTF-8 encoded and you accidently did another conversion from some charset to UTF-8. You can simply undo that by converting that the other way round. The from-charset has to be UTF-8 and the to-charset has to be the from-charset you previously accidently used. You should check to get the correct results by doing the conversion without C<--notest> before, also the C<--qfrom> option might be helpful, because the double utf-8 file names might screw up your terminal if they are being printed - they often contain control sequences which do funny things with your terminal window. If you are not sure about the charset which was accidently converted from, using C<--qfrom> is a good way to fiddle out the required encoding without destroying the file names finally. =head2 How to repair Samba files When in the smb.conf (of Samba 2.x) there hasn't been set a correct "character set" variable, files which are created from Win* clients are being created in the client's codepage, e.g. cp850 for western european languages. As a result of that the files which contain non-ASCII characters are screwed up if you "ls" them on the Unix server. If you change the "character set" variable afterwards to iso8859-1, newly created files are okay, but the old files are still screwed up in the Windows encoding. In this case convmv can also be used to convert the old Samba-shared files from cp850 to iso8859-1. By the way: Samba 3.x finally maps to UTF-8 filenames by default, so also when you migrate from Samba 2 to Samba 3 you might have to convert your file names. =head1 SEE ALSO L L L =head1 BUGS no bugs or fleas known =head1 AUTHOR Bjoern JACKE Send mail to bjoern [at] j3e.de for bug reports and suggestions. =cut require 5.008; use Getopt::Long; use File::Find; use File::Basename; use Cwd; use Encode 'from_to','encode_utf8','decode_utf8','_utf8_on','_utf8_off','decode'; #use Encode 'is_utf8'; use Unicode::Normalize; use utf8; use bytes; # byte value -> unicode char mappings ("chr"-like) my %cpwrong; my %cpright; # unicode char -> unicode code position/point mappings ("ord"-like) my %cpwrongord; my %cprightord; my $dbg = 1; Getopt::Long::Configure ("bundling"); binmode STDOUT, ":bytes"; binmode STDERR, ":bytes"; GetOptions ('nfc'=>\$opt_nfc, 'nfd'=>\$opt_nfd, 'f=s'=>\$opt_f, 't=s'=>\$opt_t, 'r'=>\$opt_r, 'i'=>\$opt_i, 'list'=>\$opt_list, 'help'=>\$opt_help, 'notest'=>\$opt_notest, 'qfrom'=>\$opt_qfrom, 'qto'=>\$opt_qto, 'replace'=>\$opt_replace, 'nosmart'=>\$opt_nosmart, 'lowmem'=>\$opt_lowmem, 'exec=s'=>\$opt_exec, 'unescape'=>\$opt_unescape, 'upper'=>\$opt_upper, 'lower'=>\$opt_lower, 'dotlessi'=>\$opt_dotlessi, 'fromcp=s'=>\$opt_demangle_f, 'tocp=s'=>\$opt_demangle_t, ) or exit 1; use File::Compare; $errors_occurred=0; $warnings_occurred=0; $maxfilenamelength=255; # $maxpathlength=4096; # this might be used somehow, somewhere? &listvalidencodings and exit 0 if ($opt_list); &printusage and exit 1 if (!@ARGV or $opt_help); if ($opt_unescape) { die "No charset conversion when unescaping!\n" if ($opt_f or $opt_t); $checkenc=\&unescape_checkenc; $get_newname=\&unescape_get_newname; } elsif ($opt_upper or $opt_lower) { die "No charset conversion when uppering/lowering!\n" if ($opt_t); die "Not possible to --upper and --lower at once!\n" if ($opt_upper and $opt_lower); $checkenc=\&upperlower_checkenc; $get_newname=\&upperlower_get_newname; $opt_f="ascii" unless ($opt_f); } elsif ($opt_demangle_f ne '' or $opt_demangle_t) { $opt_demangle_f=Encode::resolve_alias($opt_demangle_f) or die "wrong/unknown \"demangle from\" encoding!\n"; $opt_demangle_t=Encode::resolve_alias($opt_demangle_t) or die "wrong/unknown \"demangle to\" encoding!\n"; &initunmangle($opt_demangle_f, $opt_demangle_t); die('Cannot accept "from" or "to" characterset option when demangling') if ($opt_f) or ($opt_t); $opt_f = 'utf-8'; $opt_t = 'utf-8'; $checkenc=\&char_checkenc; $get_newname=\&char_get_demangled_name; } else { $opt_f=Encode::resolve_alias($opt_f) or die "wrong/unknown \"from\" encoding!\n"; $opt_t=Encode::resolve_alias($opt_t) or die "wrong/unknown \"to\" encoding!\n"; $checkenc=\&char_checkenc; $get_newname=\&char_get_newname; } $to_is_utf8 = lc($opt_t) =~ m/^utf-?8/; $from_is_utf8 = lc($opt_f) =~ m/^utf-?8/; if ($opt_qfrom) { $from_print=\&to_ascii; } else { $from_print=\&dummy; } if ($opt_qto) { $to_print=\&to_ascii; } else { $to_print=\&dummy; } if ($opt_nfc) { $norm=\&NFC; die "NFC requires UTF-8 as target charset\n" unless ($to_is_utf8); } elsif ($opt_nfd) { $norm=\&NFD; die "NFD requires UTF-8 as target charset\n" unless ($to_is_utf8); } else { $norm=\&dummy; } $opt_lowmem=1 if ($opt_exec); $pwd=cwd(); @args=@ARGV; undef @ARGV; for (@args) { die "file or directory not found: $_\n" unless (-e); } ## do {print ord($_)."_" for (split(//,$_));print "\n"; } for (@args); # debug print print STDERR "Starting a dry run without changes...\n" unless ($opt_notest); if ($opt_r) { find({wanted=>\&scan,bydepth=>1,no_chdir=>1}, @args); if (not $errors_occurred and $warnings_occurred) { $errors_occurred=1 if (&print_ask ("WARNINGS occurred. Do you really want to continue?",1)); } die "To prevent damage to your files, we won't continue.\nFirst fix this or correct options!\n" if ($errors_occurred); find({wanted=>\&process_symlink_targets,bydepth=>1,no_chdir=>1}, @args) unless ($opt_exec); find({wanted=>\&process_main,bydepth=>1,no_chdir=>1}, @args); } else { for (@args) { &scan; } if (not $errors_occurred and $warnings_occurred) { $errors_occurred=1 if (&print_ask ("WARNINGS occurred. Do you really want to continue?",1)); } die "To prevent damage to your files, we won't continue.\nFirst fix errors or correct options!\n" if ($errors_occurred); unless ($opt_exec) { for (@args) { &process_symlink_targets; } } for (@args) { &process_main; } } if ($opt_notest) { print STDERR "Ready!\n", } else { print STDERR "No changes to your files done. Use --notest to finally rename the files.\n"; } ##### ## subs ### # scan for real files and check charset first: sub scan { $arg=$_; &get_dir_base_change; if (-l $arg) { # print "link: $arg in $dir\n"; if (not defined(&$checkenc($arg))) { $errors_occurred=1 }; } elsif (-d $arg) { # print "dir: $arg in $dir\n"; $inod_fullname{(stat $arg)[1]}=$dir.$arg if (!$opt_lowmem); if (not defined(&$checkenc($arg))) { $errors_occurred=1 }; } elsif (-f $arg) { # print "file: $arg in $dir\n"; $inod_fullname{(stat $arg)[1]}=$dir.$arg if (!$opt_lowmem); if (not defined(&$checkenc($arg))) { $errors_occurred=1 }; } chdir $pwd; } # move symlink targets: sub process_symlink_targets { $arg=$_; &get_dir_base_change; if (-l $arg) { $oldlink=readlink $arg; if ((-f $oldlink or -d $oldlink) and $newname=&$get_newname($oldlink)) { if ( $newname ne $oldlink ) { if ( $inod_fullname{(stat $oldlink)[1]} or $opt_lowmem) { # = if (symlink target scanned before) #print is_utf8($oldlink) ? 1 : 0; #print is_utf8($newname) ? 1 : 0; print "symlink \"".&$from_print($File::Find::name)."\": \""; print &$from_print($oldlink)."\" >> \""; &print_ask (&$to_print($newname)."\"",$opt_i) or return; if ($opt_notest) { unlink $arg; symlink ($newname, $arg); } } else { print STDERR "link target \"",&$from_print($oldlink),"\" of \"",&$from_print($dir.$arg),"\" not in subtree, left untouched!\n"; } } # else { print "no need to convert link target: $oldlink to $newname\n"; } } } chdir $pwd; } # do the changes to all the real files/dirs/links: sub process_main { $arg=$_; &get_dir_base_change; # if (-l $arg) { # $type="symlink"; # } elsif (-d $arg) { # $type="directory"; # } elsif (-f $arg) { # $type="file"; # } if ((-l $arg) or (-d $arg) or (-f $arg)) { $newname=&$get_newname($arg); if ($newname) { if ( $newname eq $arg) { print STDERR "No need to change name \"$arg\"\n" if $dbg; } else { print STDERR "New name: for \"$arg\" is \"$newname\"\n" if $dbg; &renameit($arg,$newname); } } else { print STDERR "Failed to produce new name for \"$arg\"\n"; } } chdir $pwd; } sub char_get_newname { # retuns undef on error and string otherwise. my $oldfile=shift; my $newname; if (!$from_is_utf8 and $to_is_utf8 and !$opt_nosmart and &looks_like_utf8($oldfile)) { print STDERR "Skipping, already UTF-8: ",&$from_print($dir.$oldfile),"\n"; return $oldfile; } else { if ($from_is_utf8 and ! $to_is_utf8) { # from_to can't convert from NFD to non-UTF-8! $newname=encode_utf8(NFC(decode_utf8($oldfile))); } else { $newname=$oldfile; } from_to($newname, $opt_f, $opt_t, Encode::FB_QUIET) or die "SHOULD NOT HAPPEN HERE: conversion error, so suitable charset used?: \"$oldfile\"\nTo prevent damage to your files, we won't continue. First fix this!\n"; $newname=&$norm(decode_utf8($newname)) if ($to_is_utf8); return $newname; } } sub get_dir_base_change() { $arg =~ s/\/*$//; $dir=dirname($arg)."/"; $arg=basename($arg); chdir $dir; } sub renameit() { my $oldfile=shift; my $newname=shift; my $cmd; $newname=encode_utf8($newname) if ($to_is_utf8); if ($opt_exec) { $cmd = $opt_exec; $cmd =~ s/\#2/\000f8d9hqoäd\#2/g; # make the #2 unique so that file names may contain "#2" $cmd =~ s/\#1/\Q$oldfile\E/g; $cmd =~ s/\000f8d9hqoäd\#2/\Q$newname\E/g; print "$cmd\n"; } else { #print is_utf8($oldfile) ? 1 : 0; #print is_utf8($newname) ? 1 : 0; &print_ask ("mv \"". &$from_print($dir.$oldfile)."\"\t\"".&$from_print($dir).&$to_print($newname)."\"",$opt_i) or return; } if (-e $newname and !$opt_exec) { if ($opt_replace and !&compare($oldfile,$newname)) { if ($opt_notest) { unlink $newname or print STDERR "Error: $!\n"; rename ($oldfile, $newname) or print STDERR "Error: $!\n"; } } else { print STDERR &$to_print($newname)," exists and differs or --replace option missing - skipped\n"; } } else { if ($opt_notest) { if ($opt_exec) { system($cmd); } else { rename ($oldfile, $newname) or print STDERR "Error: $!\n"; } } } } sub listvalidencodings() { print "$_\n" for (Encode->encodings(":all")); return 1; } sub char_checkenc() { my $oldfile=shift; my $new=$oldfile; if ($from_is_utf8) { if (! &this_is_valid_utf8($new)) { print STDERR "this file was not validly encoded in UTF-8: \"". &$from_print($dir.$oldfile) ."\"\n"; return undef; } } else { if ($to_is_utf8 and !$opt_nosmart and &looks_like_utf8($oldfile)) { # do nothing: e.g. from_enc is shift_jis but string is utf-8. Should # be "smart-skipped" if to_enc is utf-8 and not produce no error here. } elsif (! from_to($new,$opt_f, "utf8", Encode::FB_QUIET) ) { print STDERR "this file was not validly encoded in $opt_f: \"". &$from_print($dir.$oldfile) ."\"\n"; return undef; } } # $new is utf-8 now and $oldfile's encoding was valid ... my $filenamelength; if ($to_is_utf8) { $new = &$norm($new); $filenamelength=length($new); } else { $new=encode_utf8(NFC(decode_utf8($new))); $filenamelength=from_to($new, "utf8", $opt_t, Encode::FB_QUIET); } ## print "$oldfile|$utf8oldfile|$new|$filenamelength\n"; if (! $filenamelength) { print STDERR "$opt_t doesn't cover all needed characters for: \"". &$from_print($dir.$oldfile) ."\"\n"; return undef; } elsif ($filenamelength > $maxfilenamelength) { print STDERR &$from_print($dir.$oldfile).": resulting filename is $filenamelength bytes long (max: $maxfilenamelength)\n"; return undef; } &posix_check($new); return 1; } sub printusage { print < This program comes with ABSOLUTELY NO WARRANTY; it may be copied or modified under the terms of the GNU General Public License version 2 as published by the Free Software Foundation. USAGE: convmv [options] FILE(S) -f enc encoding *from* which should be converted -t enc encoding *to* which should be converted -r recursively go through directories -i interactive mode (ask for each action) --nfc target files will be normalization form C for UTF-8 (Linux etc.) --nfd target files will be normalization form D for UTF-8 (OS X etc.) --qfrom be quiet about the "from" of a rename (if it screws up your terminal e.g.) --qto be quiet about the "to" of a rename (if it screws up your terminal e.g.) --fromcp source code page --tocp destination code page --exec c execute command instead of rename (use #1 and #2 and see man page) --list list all available encodings --lowmem keep memory footprint low (see man page) --nosmart ignore if files already seem to be UTF-8 and convert if posible --notest actually do rename the files --replace will replace files if they are equal --unescape convert%20ugly%20escape%20sequences --upper turn to upper case --lower turn to lower case --help print this help END #--dotlessi care about the dotless i issue of certain locales (use with care) } sub looks_like_utf8() { my $string = shift; if ($string =~ m/[^[:ascii:]]/ and &this_is_valid_utf8($string)) { return 1; } else { return undef; } } sub this_is_valid_utf8() { my $string = shift; # until 1.08 I used to used decode_utf8() but see perl bug #37757 (perl 5.8.7/8) # let's look for a different way to find valid utf-8 ...: #utf8::decode() is experimental and might disappear says utf8(3pm): #if (utf8::decode($string) != undef) { # Encode::decode does not work as one might expect: #if (Encode::decode(utf8,$string,Encode::FB_QUIET) == undef) { # from_to() works for all Perl versions (at the moment ;) if (from_to($string,utf8,utf8,Encode::FB_QUIET) == undef) { return undef; } else { return 1; } } sub to_ascii() { my $a=shift; $a =~ s/[^[:ascii:]]/?/g; $a =~ s/[[:cntrl:]]/*/g; return $a; } sub dummy() { return shift; } sub print_ask() { # takes 2 arguments, string and askornot my $a=""; print shift; my $ask = shift; while ($ask and not $a =~ m/^[yn]$/i) { print " (y/n) "; $a=<>; } print "\n"; if ($a =~ m/^n$/i) { return undef; } else { return 1; } } sub unescape_checkenc() { my $name = shift; if ($name =~ m/^[[:ascii:]]*$/) { # should we be more strict ? &posix_check(&unescape_get_newname($name)); return 1; } else { print STDERR "\"",&$from_print($name),"\" not ASCII - this does not seem to be an escaped filename.\n"; return undef; } } sub unescape_get_newname() { # return undef on error, string otherwise my $newname = shift; # $newname =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; # this was done before $newname =~ s/(%)([0-9a-fA-F][0-9a-fA-F])/chr(hex($2))/eg; return $newname; } sub upperlower_checkenc() { my $oldname = shift; my $newname = upperlower_get_newname($oldname); if (not defined($newname)) { return undef; } else { &posix_check($newname); return 1; } } sub upperlower_get_newname() { # return undef on error, string otherwise my $oldname = shift; my $name=$oldname; if (! from_to($name, $opt_f, "utf8", Encode::FB_QUIET)) { # should also leave NFD as it is ... print STDERR "\"",&$from_print($oldname),"\" not encoded in $opt_f ? Supply the correct encoding via -f option!\n"; return undef; } _utf8_on($name); # Unicode in Perl can be a real pain ... no bytes; if ($opt_upper) { if ($opt_dotlessi) { $name =~ s/ı/I/g; $name =~ s/i/İ/g; } # we do not want to upper ß to SS ! Let's substitute it with NUL+DWSLQH (NUL may not be part of filename) and get it back after uc() $name =~ s/ß/\000DWSLQH/g; $name = uc($name); $name =~ s/\000DWSLQH/ß/g; } else { if ($opt_dotlessi) { $name =~ s/I/ı/g; $name =~ s/İ/i/g; } $name = lc($name); } use bytes; _utf8_off($name); # we should also do special treatment for UTF-8 NFD of "I with dot above" in byte mode now, otherwise we get "i̇", which is a double-single dotted i ;-) # the problems that arise with this letter are endless ... # $name =~ s/i\314\207/i/g if ($from_is_utf8); if (! from_to($name, "utf8", $opt_f, Encode::FB_QUIET)) { print STDERR $opt_upper?"Upper":"Lower","case of \"",&$from_print($oldname),"\" not possible in $opt_f ! Maybe supply different encoding via -f option.\n"; return undef; } return $name; } sub posix_check() { my $name=shift; if ($name =~ m/[\000\/]/) { print STDERR "WARNING: new filename \"",&$to_print($name),"\" contains characters, which are not POSIX filesystem conform! This may result in data loss.\n"; $warnings_occurred=1; } } sub initunmangle($$) { my ($wrongcpname, $rightcpname) = @_; no bytes; print STDERR "Initialising demangle table for $wrongcpname -> $rightcpname\n"; # FIXME: Hardwired assumption of 8-bit codepages for now. # Do we have a way to determine the max. code point value for a # character set? If so, fix this... # Set up the chr- and ord-style mappings foreach my $i (0 .. 255) { my $char = decode($wrongcpname, pack('C', $i)); $cpwrong{$i} = $char; $cpwrongord{unpack('%U',$char)} = $i; } foreach my $i (0 .. 255) { my $char = decode($rightcpname, pack('C', $i)); $cpright{$i} = $char; $cprightord{unpack('%U',$char)} = $i; } # showtable(); } # Demangle a single (unicode) character using the mappings. sub demangle($) { no bytes; my ($codepoint) = @_; my $c = unpack('%U', $codepoint); if (defined($cpwrongord{$c})) { if (defined($cpright{$cpwrongord{$c}})) { return $cpright{$cpwrongord{$c}}; } } return $codepoint; } sub char_get_demangled_name ($) { no bytes; # returns undef on error and string otherwise. my ($oldfile) = @_; my $newname; # FIXME: sanity check &looks_like_utf8($oldfile) _utf8_on($oldfile); $newname = $oldfile; $newname =~ s/(.)/&demangle($1)/eg; _utf8_on($newname); $newname=&$norm($newname); _utf8_on($newname); return $newname; } sub showtable() { no bytes; binmode(STDOUT, ':utf8'); print "Demangling table $wrongcpname -> $rightcpname:\n"; foreach my $i (sort {$a <=> $b} keys %cpwrong) { my $w = unpack('U', $cpwrong{$i}); my $r = unpack('U', &demangle($cpwrong{$i})); next if $w eq $r; # Skip identity mappings # This is rough around the edges - no attempt is made to decide # whether the particular Unicode positions are actually # "printable". printf "(dec %3s, 0x%02X) \`%s' -> \`%s'\t(Ux%04X -> Ux%04X)\n", $i, $i, $cpwrong{$i}, &demangle($cpwrong{$i}), $w, $r; } }