¿Cómo copio un archivo con un nombre de archivo UTF-8 a otro nombre de archivo UTF-8 en Perl en Windows?

Question

Por ejemplo, dado un archivo vacío テスト.txt, ¿cómo haría una copia llamada テスト.txt.copy?

Mi primera grieta en que logró acceder al archivo y crear el nuevo nombre de archivo, pero la copia generó テスト.txt.copy.

Aquí fue mi primera grieta en ella:

#!/usr/bin/env perl 

use strict; 
use warnings; 

use English '-no_match_vars'; 
use File::Basename; 
use Getopt::Long; 

use File::Copy; 
use Win32; 

my (
    $output_relfilepath, 
    ) = process_command_line(); 

open my $fh, '>', $output_relfilepath or die $!; 
binmode $fh, ':utf8'; 
foreach my $short_basename (glob('*.txt')) { 

    # skip the output basename if it's in the glob 
    if ($short_basename eq $output_relfilepath) { 
    next; 
    } 

    my $long_basename = Win32::GetLongPathName($short_basename); 
    my $new_basename = $long_basename . '.copy'; 

    print {$fh} sprintf(
         "short_basename = (%s)\n" . 
         " long_basename = (%s)\n" . 
         " new_basename = (%s)\n", 
         $short_basename, 
         $long_basename, 
         $new_basename, 
        ); 
    copy($short_basename, $new_basename); 
} 

printf(
     "\n%s done! (%d seconds elapsed)\n", 
     basename($0), 
     time() - $BASETIME, 
    ); 

# === subroutines === 

sub process_command_line { 

    # default arguments 
    my %args 
    = (
     output_relfilepath => 'output.txt', 
    ); 

    GetOptions(
      'help'     => sub { print usage(); exit }, 
      'output_relfilepath=s' => \$args{output_relfilepath}, 
      ); 

    return (
      $args{output_relfilepath}, 
     ); 
} 

sub usage { 
    my $script_name = basename $0; 

    my $usage = <<END_USAGE; 
====================================================================== 

Test script to copy files with a UTF-8 filenames to files with 
different UTF-8 filenames. This example tries to make copies of all 
.txt files with versions that end in .txt.copy. 

    usage: ${script_name} (<options>) 

options: 

    -output_relfilepath <s> set the output relative file path to <s>. 
          this file contains the short, long, and 
          new basenames. 
          (default: 'output.txt') 

---------------------------------------------------------------------- 

examples: 

    ${script_name} 

====================================================================== 
END_USAGE 

    return $usage; 
} 

aquí están los contenidos de output.txt después de la ejecución:

short_basename = (BD9A~1.TXT) 
long_basename = (テスト.txt) 
    new_basename = (テスト.txt.copy) 

He intentado reemplazar File::Copy 's comando copy con una llamada al sistema:

my $cmd = "copy \"${short_basename}\" \"${new_basename}\""; 
print `$cmd`; 

y con Win32 :: CopyFile:

Win32::CopyFile($short_basename, $new_basename, 'true'); 

Lamentablemente, obtengo el mismo resultado en ambos casos (テスト.txt.copy). Para la llamada al sistema, la impresión muestra 1 file(s) copied. como se esperaba.

Notas:

• Estoy corriendo a través de Perl 5.10.0 Strawberry Perl en Windows 7 Professional
• utilizo el módulo Win32 acceder a los nombres de archivo largos
• Los rendimientos glob nombres de archivo cortos, que tengo a utilizar para acceder al archivo
• テ ス ト = prueba (tesuto) en katakana
• he leído y perlunitutThe Absolute Minimum Every Software Developer Absolutely, Positively Must Know About Unicode and Character Sets (No Excuses!)

Answer 1

Obtiene el nombre de archivo largo con Win32, que le proporciona una cadena codificada en UTF-8.

Sin embargo, usted es entonces configurando el nombre de archivo largo usando plain copy, que usa las funciones de C stdlib IO. Las funciones stdlib usan la codificación predeterminada del sistema de archivos.

En Linuxes modernos, generalmente es UTF-8, pero en Windows (por desgracia) nunca lo es, porque la página de códigos predeterminada del sistema no se puede configurar en UTF-8. Por lo tanto, obtendrá su cadena UTF-8 interpretada como una cadena de códigos de página 1252 en una instalación de Windows Europa occidental, como ha sucedido aquí. (En una máquina japonesa que se obtendría interpreta como código de la página 932 - como Shift-JIS - lo cual habría salido algo así como 繝�せ繝�.)

No he hecho esto en Perl, pero me gustaría sospechar la función Win32::CopyFile es más probable que sea capaz de manejar el tipo de rutas Unicode devueltas en otro lugar en el módulo Win32.

Answer 2

Esto debería ser posible con la función CopyFileW de Win32API::File, que debe incluirse con Strawberry. Nunca me he equivocado con los nombres de archivo Unicode, así que no estoy seguro de los detalles. Es posible que necesite usar Encode para convertir manualmente el nombre de archivo a UTF-16LE (encode('UTF16-LE', $filename)).

Answer 3

He duplicado correctamente su problema en mi máquina con Windows (versión Win XP Simplified Chinese) y mi conclusión es que el problema está causado por la fuente. Elija una fuente Truetype en lugar de fuentes Raster y vea si todo está bien.

Mi experimento es la siguiente:

1. primera vez que cambia la página de códigos de mi consola de Windows desde el valor predeterminado 936 (JDS) a 65001 (UTF-8). escribiendo C:> chcp 65001

2. Escribí un scrip que contiene el código: $ a = "テ ス ト"; imprimir $ a; y lo guardó como UTF-8.

3. Ejecuté el script desde la consola y encontré que "テ ス became" se convirtió en "ム† ã,¹ãƒ", que es exactamente el mismo síntoma que describiste en tu pregunta.

4. Cambié la fuente de la consola de fuentes Raster a Lucida Console, la pantalla de la consola me dio esto: "テ ス ト,,,,", que todavía no es del todo correcto, pero supongo que se está acercando al núcleo del problema.

Así que aunque no estoy 100% seguro, pero el problema probablemente sea causado por la fuente.

Espero que esto ayude.

Answer 4

Uso Encode::Locale:

use Encode::Locale; 
use Encode; 
use File::Copy; 

copy(encode(locale_fs => $short_basename), 
     encode(locale_fs => $new_basename)) || die $!; 

Answer 5

Ver https://metacpan.org/pod/Win32::Unicode

#!/usr/bin/perl -- 
use utf8; 
use strict; 
use warnings; 

my @kebabs = (
    "\x{45B}\x{435}\x{432}\x{430}\x{43F}.txt",    ## ћевап.txt 
    "ra\x{17E}nji\x{107}.txt",        ## ražnjić.txt 
    "\x{107}evap.txt",          ## ćevap.txt 
    "\x{43A}\x{435}\x{431}\x{430}\x{43F}\x{447}\x{435}.txt", ## кебапче.txt 
    "kebab.txt", 
); 

{ 
    use Win32::Unicode qw/ -native /; 
    printW "I \x{2665} Perl"; # unicode console out 
    mkpathW 'meat'; 
    chdirW 'meat'; 
    for my $kebab (@kebabs){ 
     printW "kebabing the $kebab\n"; 
     open my($fh), '>:raw', $kebab or dieW Fudge($kebab); 
     print $fh $kebab    or dieW Fudge($kebab); 
     close $fh      or dieW Fudge($kebab); 
    } 
} 

sub Fudge { 
    use Errno(); 
    join qq/\n/, 
     "Error @_", 
     map { " $_" } int($!) . q//. $!, 
     int($^E) . q//. $^E, 
     grep({ $!{$_} } keys %!), 
     q/ /; 
}