如何从 Perl 创建然后使用长 Windows 路径？

我有一个构建过程的一部分，它在 Windows 中创建了一条长得可怕的路径。这不是我的错。它有几个目录深，并且没有一个目录名异常长；它们又长又多，足以让它过去MAX_PATH（260 个字符）。我在这些名称中没有使用除 ASCII 之外的任何内容。

最大的问题是爆炸发生在内心深处模块::构建 http://search.cpan.org/dist/Module-Build在此期间dist目标，尽管我认为构建系统并不重要，因为它们会创建相同的目录。

创建这些过长的目录之一File::Path fails:

 use File::Path qw( make_path );

 make_path( 'C:\\.....' ); # fails if path is over 260 chars

同样，一旦绝对路径超出，手动构建每个目录级别就会失败MAX_PATH.

这不是什么新鲜事，也不是 Perl 的错，微软将其记录在命名文件、路径和命名空间 http://msdn.microsoft.com/en-us/library/aa365247%28VS.85%29.aspx#maximum_path_length。他们的修复建议添加\\?\在访问 Unicode 文件名 API 的任何路径前面。然而，这似乎并不是 Perl 脚本的完整修复，因为它仍然失败：

 use File::Path qw( make_path );

 make_path( '\\\\?\\C:\\.....' );  # still fails if path is over MAX_PATH, works otherwise

这可能是因为make_path分解它的参数，然后一次一层地浏览目录，所以\\?\仅适用于顶层，即在MAX_PATH.

我挖了一个向 ActiveState 报告错误 http://bugs.activestate.com/show_bug.cgi?id=26342这表明我还需要修复一些其他问题才能获得 Unicode 文件名，Jan Dubois 提供了更多详细信息回复：Windows 2K/XP 上的“长”文件名 http://www.mail-archive.com/perl-win32-users@listserv.activestate.com/msg22349.html，尽管我不确定它是否适用（并且非常旧）。perlrun http://perldoc.perl.org/perlrun.html提到这曾经是-C开关，但显然那部分被放弃了。 Perl RT 队列有一个更新的错误60888：Win32：支持文件名中的完整 unicode（使用宽系统调用） http://rt.perl.org/rt3/Public/Bug/Display.html?id=60888.

宫川注意一些 Unicode 文件名问题 http://bulknews.typepad.com/blog/2008/12/pathclass-and-unicode-filename-woes.html and Win32API::文件 http://search.cpan.org/dist/Win32API-File无需特别提及长路径。但是，那Win32API::File CPAN 论坛条目 http://www.cpanforum.com/threads/10658似乎只表示恐惧，恐惧会导致愤怒，恐惧会导致仇恨，等等。中有一个例子佩尔蒙克斯 http://www.perlmonks.org/ post 如何在 Windows 中统计具有 Unicode (UTF16-LE) 文件名的文件？ http://www.perlmonks.org/?node_id=741797。看来Win32::CreateDirectory就是答案，下次我走到 Windows 机器旁边时我会尝试一下。

然后，假设我可以创建长路径。现在我必须教 Module::Build，也许还有其他东西来处理它。如果使用猴子补丁，这可能会立即变得容易Win32::GetANSIPathName()它在锡上说了什么。

Windows 对于每个需要处理字符串的函数有两个单独的系统调用，一个使用 ANSI 又名活动代码页作为编码（例如 cp1252）的“A”调用，一个使用 UTF-16le 的“W”调用。 Perl 使用“A”调用，而\\?\仅适用于“W”呼叫。

您可以使用 Win32::API 访问“W”调用，如下面的脚本所示，但是Win32::长路径 https://metacpan.org/pod/Win32::LongPath不仅使用“W”调用，而且自动添加\\?\!

使用Win32::API调用示例CreateDirectoryW使用长路径（\\?\-前缀路径）：

#!/usr/bin/perl

use strict;
use warnings;

use Carp;
use Encode qw( encode );
use Symbol;

use Win32;

use Win32API::File qw(
    CreateFileW OsFHandleOpen
    FILE_GENERIC_READ FILE_GENERIC_WRITE
    OPEN_EXISTING CREATE_ALWAYS FILE_SHARE_READ
);

use Win32::API;
use File::Spec::Functions qw(catfile);

Win32::API->Import(
    Kernel32 => qq{BOOL CreateDirectoryW(LPWSTR lpPathNameW, VOID *p)}
);

my %modes = (
    '<' => {
        access => FILE_GENERIC_READ,
        create => OPEN_EXISTING,
        mode   => 'r',
    },
    '>' => {
        access => FILE_GENERIC_WRITE,
        create => CREATE_ALWAYS,
        mode   => 'w',
    },
    # and the rest ...
);

use ex::override open => sub(*;$@) {
    $_[0] = gensym;

    my %mode = %{ $modes{$_[1]} };

    my $os_fh = CreateFileW(
        encode('UCS-2le', "$_[2]\0"),
        $mode{access},
        FILE_SHARE_READ,
        [],
        $mode{create},
        0,
        [],
    ) or do {$! = $^E; return };

    OsFHandleOpen($_[0], $os_fh, $mode{mode}) or return;
    return 1;
};

my $path = '\\\\?\\' . Win32::GetLongPathName($ENV{TEMP});
my @comps = ('0123456789') x 30;

my $dir = mk_long_dir($path, \@comps);
my $file = 'test.txt';
my $str = "This is a test\n";

write_test_file($dir, $file, $str);

$str eq read_test_file($dir, $file) or die "Read failure\n";

sub write_test_file {
    my ($dir, $file, $str) = @_,

    my $path = catfile $dir, $file;

    open my $fh, '>', $path
        or croak "Cannot open '$path':$!";

    print $fh $str or die "Cannot print: $!";
    close $fh or die "Cannot close: $!";
    return;
}

sub read_test_file {
    my ($dir, $file) = @_,

    my $path = catfile $dir, $file;

    open my $fh, '<', $path
        or croak "Cannot open '$path': $!";

    my $contents = do { local $/; <$fh> };
    close $fh or die "Cannot close: $!";
    return $contents;
}

sub mk_long_dir {
    my ($path, $comps) = @_;

    for my $comp ( @$comps ) {
        $path = catfile $path, $comp;
        my $ucs_path = encode('UCS-2le', "$path\0");
        CreateDirectoryW($ucs_path, undef)
            or croak "Failed to create directory: '$path': $^E";
    }
    return $path;
}