Perl：Windows中文件名的变音符号问题

Question

我用 perl 编写了一个程序来操作（创建、删除、打开、关闭、读取、写入、复制等）文件和目录。它在 Linux (Ubuntu) 和 macOS 上运行时做得很好。但它也必须在 Windows 下做同样的工作，而且我对包含非 ASCII 字符的文件名的编码有问题（例如德语变音符号，还有任何其他非 ASCII 字符）。

由于我的原始程序太大，我创建了一个较短的程序进行测试。
这是我的第一个简单版本的 perl 程序的缩短版（程序文件本身被编码为 UTF-8）：

#!/usr/bin/perl -w

use strict;
use warnings;

my $filename = 'FäöüßÄÖÜẞçàéâœ.txt';
my $text     = 'TäöüßÄÖÜẞçàéâœ';
my $dirname  = 'DäöüßÄÖÜẞçàéâœ';


# list all files in the parent directory before any action -------------

listDirectory('.');

# create file and write into file --------------------------------------

print "Going to open file $filename for writing ... ";
if (open(my $fileHandle, '>', $filename)) {
    print "done successfully\n";
    print "Going to write text '$text' into file $filename ... ";
    if (print $fileHandle $text."\n") {
        print "done successfully\n";
    } else {
        errorExit("failed to write into file", __LINE__);
    }
    close($fileHandle);
} else {
    errorExit("failed to open file for writing", __LINE__);
}

# create a new directory -----------------------------------------------

print "Going to create directory $dirname ... ";
if (mkdir($dirname)) {
    print "done successfully\n";
} else {
    errorExit("failed to create directory", __LINE__);
}

# list all files in the parent directory again -------------------------

listDirectory('.');

# read file ------------------------------------------------------------

print "Going to open file $filename for reading ... ";
if (open(my $fileHandle, '<', $filename)) {
    print "done successfully\n";
    print "Going to list content of file $filename:\n";
    print "--- begin of content ---\n";
    while (my $row = <$fileHandle>) {
        chomp $row;
        print "$row\n";
    }
    print "--- end of content ---\n\n";
    close($fileHandle);
} else {
    errorExit("failed to open file for reading", __LINE__);
}

# list all files in the newly created directory ------------------------

listDirectory($dirname);

# end ------------------------------------------------------------------

print "normal end of execution\n";
exit(0);

# subroutines ==========================================================


# list all files in a directory ----------------------------------------

sub listDirectory {
    my $dir = shift;
    my $dirname = $dir eq '.' ? 'parent directory' : $dir;
    print "Content of $dirname\n";
    if (opendir (my $dirHandle, $dir)) {
        print "--- begin of content of $dirname ---\n";
        while (my $file = readdir($dirHandle)) {
            print "$file\n";
        }
        print "--- end of content of $dirname ---\n\n";
        closedir($dirHandle);
    } else {
        errorExit("failed to open $dirname", __LINE__);
    }
}

# Error exit -----------------------------------------------------------

sub errorExit {
    my $message = shift;
    my $line = shift;
    print "Error before line $line:\n";
    print "program message: $message\n";
    print "system message: $!\n";
    print "premature end of execution\n";
    exit(0);
}

我的程序在 macOS 和 Linux (Ubuntu) 中的输出：

Content of parent directory
--- begin of content of parent directory ---
.
..
testUmlaut.pl
--- end of content of parent directory ---

Going to open file FäöüßÄÖÜẞçàéâœ.txt for writing ... done successfully
Going to write text 'TäöüßÄÖÜẞçàéâœ' into file FäöüßÄÖÜẞçàéâœ.txt ... done successfully
Going to create directory DäöüßÄÖÜẞçàé✠... done successfully
Content of parent directory
--- begin of content of parent directory ---
.
..
testUmlaut.pl
FäöüßÄÖÜẞçàéâœ.txt
DäöüßÄÖÜẞçàéâœ
--- end of content of parent directory ---

Going to open file FäöüßÄÖÜẞçàéâœ.txt for reading ... done successfully
Going to list content of file FäöüßÄÖÜẞçàéâœ.txt:
--- begin of content ---
TäöüßÄÖÜẞçàéâœ
--- end of content ---

Content of DäöüßÄÖÜẞçàéâœ
--- begin of content of DäöüßÄÖÜẞçàé✠---
.
..
--- end of content of DäöüßÄÖÜẞçàé✠---

normal end of execution

这是预期的输出。

但是当我在 Windows 机器上执行这个程序时，我得到了这个：

Content of parent directory
--- begin of content of parent directory ---
.
..
testUmlaut.pl
--- end of content of parent directory ---

Going to open file F├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô.txt for writing ... done successfully
Going to write text 'T├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô' into file F├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô.txt ... done successfully
Going to create directory D├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô ... done successfully
Content of parent directory
--- begin of content of parent directory ---
.
..
testUmlaut.pl
F├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô.txt
D├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô
--- end of content of parent directory ---

Going to open file F├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô.txt for reading ... done successfully
Going to list content of file F├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô.txt:
--- begin of content ---
T├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô
--- end of content ---

Content of D├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô
--- begin of content of D├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô ---
.
..
--- end of content of D├ñ├Â├╝├ƒ├ä├û├£ß║×├º├á├®├ó┼ô ---

normal end of execution

因此，所有文件名都使用错误的编码编写。同样在资源管理器中，您会看到新文件和目录的错误编码文件名。但是虽然文本文件包含了正确的内容，但我的程序却显示错了。

所以，我摆弄着我的程序，直到我得到一个能产生正确输出的版本（与 macOS 和 Linux 下的第一个 naïve 版本的输出相同）。

但在文件系统中，文件名仍然是错误的：

13.01.2020  17:36    <DIR>          .
10.01.2020  14:46    <DIR>          ..
13.01.2020  18:23             2 970 testUmlaut.pl
13.01.2020  18:23                30 FäöüßÄÖÜẞçà éâœ.txt
13.01.2020  18:23    <DIR>          DäöüßÄÖÜẞçà éâœ

这是我的程序新版本的代码：

#!/usr/bin/perl -w

use strict;
use warnings;
use utf8;
use Encode;
if ($^O eq 'MSWin32') {
    require Win32::Console;
    Win32::Console::OutputCP(65001);
}

binmode STDOUT, ":utf8";

my $filename = 'FäöüßÄÖÜẞçàéâœ.txt';
my $text     = 'TäöüßÄÖÜẞçàéâœ';
my $dirname  = 'DäöüßÄÖÜẞçàéâœ';


# list all files in the parent directory before any action -------------

listDirectory('.');

# create file and write into file --------------------------------------

print "Going to open file $filename for writing ... ";
if (open(my $fileHandle, '>:encoding(UTF-8)', $filename)) {
    print "done successfully\n";
    print "Going to write text '$text' into file $filename ... ";
    if (print $fileHandle $text."\n") {
        print "done successfully\n";
    } else {
        errorExit("failed to write into file", __LINE__);
    }
    close($fileHandle);
} else {
    errorExit("failed to open file for writing", __LINE__);
}

# create a new directory -----------------------------------------------

print "Going to create directory $dirname ... ";
if (mkdir($dirname)) {
    print "done successfully\n";
} else {
    errorExit("failed to create directory", __LINE__);
}

# list all files in the parent directory again -------------------------

listDirectory('.');

# read file ------------------------------------------------------------

print "Going to open file $filename for reading ... ";
if (open(my $fileHandle, '<:encoding(UTF-8)', $filename)) {
    print "done successfully\n";
    print "Going to list content of file $filename:\n";
    print "--- begin of content ---\n";
    while (my $row = <$fileHandle>) {
        chomp $row;
        print "$row\n";
    }
    print "--- end of content ---\n\n";
    close($fileHandle);
} else {
    errorExit("failed to open file for reading", __LINE__);
}

# list all files in the newly created directory ------------------------

listDirectory($dirname);

# end ------------------------------------------------------------------

print "normal end of execution\n";
exit(0);

# subroutines ==========================================================


# list all files in a directory ----------------------------------------

sub listDirectory {
    my $dir = shift;
    my $dirname = $dir eq '.' ? 'parent directory' : $dir;
    print "Content of $dirname\n";
    if (opendir (my $dirHandle, $dir)) {
        print "--- begin of content of $dirname ---\n";
        while (my $file = decode_utf8(readdir($dirHandle))) {
            print "$file\n";
        }
        print "--- end of content of $dirname ---\n\n";
        closedir($dirHandle);
    } else {
        errorExit("failed to open $dirname", __LINE__);
    }
}

# Error exit -----------------------------------------------------------

sub errorExit {
    my $message = shift;
    my $line = shift;
    print "Error before line $line:\n";
    print "program message: $message\n";
    print "system message: $!\n";
    print "premature end of execution\n";
    exit(0);
}

这个新版本在 Linux 或 macOS 中运行时仍然表现良好。但是Windows中的文件名仍然存在这个问题。

我该如何解决这个问题？

Answer 1

接受/返回字符串的 Windows 系统调用有两种。 “A”（ANSI）版本处理使用系统的活动代码页编码的文本，“W”（宽）版本处理使用 UTF-16le 编码的文本。

Perl 仅使用“A”版本，因此期望使用活动代码页对文件名进行编码（例如，cp1252 用于大多数美国机器。）

一种解决方案是使用正确的代码页对文件名进行编码。

use utf8;  # Source code encoded using UTF-8.

my ($cie, $coe, $ae);    
BEGIN {
   require Win32;
   $cie = "cp" . Win32::GetConsoleCP();
   $coe = "cp" . Win32::GetConsoleOutputCP();
   $ae  = "cp" . Win32::GetACP();

   binmode(STDIN,  ":encoding($cie)");
   binmode(STDOUT, ":encoding($coe)");
   binmode(STDERR, ":encoding($coe)");

   require "open.pm";
   "open"->import(":encoding($ae)");  # Default encoding for open()
}

use Encode qw( encode );

#my $qfn = 'FäöüßÄÖÜẞçàéâœ.txt';
my $qfn = 'FäöüßÄÖÜßçàéâœ.txt';

open(my $fh, '>', encode($ae, $qfn))
   or die("Can't create \"$qfn\": $!\n");

print($fh "This is \"$qfn\".\n");

请注意，我将“ẞ”替换为“ß”，因为“ẞ”不在我的活动代码页 (cp1252) 的字符集中，因此不能用作文件名的一部分。为了避免这个问题，需要使用 Wide 接口。这可以使用Win32::Unicode::File 和Win32::Unicode::Dir 或Win32::LongPath 来实现。

use utf8;  # Source code encoded using UTF-8.

my ($cie, $coe, $ae);    
BEGIN {
   require Win32;
   $cie = "cp" . Win32::GetConsoleCP();
   $coe = "cp" . Win32::GetConsoleOutputCP();
   $ae  = "cp" . Win32::GetACP();

   binmode(STDIN,  ":encoding($cie)");
   binmode(STDOUT, ":encoding($coe)");
   binmode(STDERR, ":encoding($coe)");

   require "open.pm";
   "open"->import(":encoding($ae)");  # Default encoding for open()
}

use Win32::Unicode::File qw( );

my $qfn = 'FäöüßÄÖÜẞçàéâœ.txt';

my $fh = Win32::Unicode::File->new('>', $qfn)
   or die("Can't create \"$qfn\": $!\n");

binmode($fh, ":encoding($ae)");  # Didn't happen automatically since we didn't use open()

print($fh "This is \"$qfn\".\n");

阅读更多关于这个here的信息。