Perl: Umlaut-issue with filenames in windows - windows

Question

I wrote a program in perl that manipulates (create, delete, open, close, read, write, copy, etc.) files and directories. It does this very well when running on Linux (Ubuntu) and also on macOS. But it has to do the same job under windows too, and there I have problems with the encodings of file names that contain characters other than ASCII (for example German Umlauts, but also any other non-ASCII characters).
Since my original program is way too big, I created a shorter program for testing.
This is the shortened equivalent of my first, naive version of my perl program (the program file itself is encoded as 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);
}
Output of my program in macOS and in 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
This is the expected output.
But I get this when I execute this program on a windows machine:
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
So, all filenames are written with a wrong encoding. Also in the explorer you see misscoded filenames for the new file and directory. But although the text file contains the correct content, my program displays it wrong.
So, I fiddeled around with my program until I got a version, that produces the correct output (identical to the output of the first naïve version under macOS and Linux)).
But in the file system the filenames are still wrong:
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äöüßÄÖÜẞçà éâœ
Here is the code of the new version of my program:
#!/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);
}
This new version still behaves well when running in Linux or macOS. But there is still this issue with the filenames in Windows.
How can I fix this?

Answer 1

Windows system calls that accept/return string come in two varieties. The "A" (ANSI) version that deals with text encoded using the system's Active Code Page, and the "W" (Wide) version that deals with text encoded using UTF-16le.
Perl uses the "A" version exclusively, and thus expects file names to be encoded using the Active Code Page (e.g. cp1252 for most US machines.)
One solution is to encode the file name using the correct code page.
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");
Note that I replaced "ẞ" with "ß" because "ẞ" isn't present in the character set of my active code page (cp1252), and thus couldn't be used as part of the file name. To avoid this problem, one needs to use the Wide interface. This can be achieved using Win32::Unicode::File and Win32::Unicode::Dir, or 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");
Read a bit more about this here.