How do I create then use long Windows paths from Perl?

风流意气都作罢 提交于 2019-11-26 22:57:22

问题


I have part of a build process that creates a hideously long paths in Windows. It's not my fault. It's several directories deep, and none of the directory names are abnormally long; they're just long and numerous enough to make it over MAX_PATH (260 chars). I'm not using anything other than ASCII in these names.

The big problem is that the blow-up happens deep in the guts of Module::Build during the dist target, although I figure the build system doesn't matter because they'd make the same directories.

Creating one of these overly-long directories with File::Path fails:

 use File::Path qw( make_path );

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

Similarly, constructing each directory level by hand fails once the absolute path would go over MAX_PATH.

This isn't new, isn't Perl's fault, and Microsoft documents it in Naming Files, Paths, and Namespaces. Their fix suggests adding the \\?\ in front of any path to access the Unicode filename API. However, that doesn't seem to be the full fix for a Perl script because it still fails:

 use File::Path qw( make_path );

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

This might be because make_path pulls apart its argument and then goes through the directories one level at a time, so \\?\ only applies to the top-level, which is within MAX_PATH.

I dug up a bug report to ActiveState that suggests there's something else I need to fix up to get to the Unicode filenames, and Jan Dubois gives a bit more details in Re: "long" filenames on Windows 2K/XP, although I'm not sure it applies (and is extremely old). perlrun mentions that this use to be the job of the -C switch, but apparently that part was abandoned. The perl RT queue has a more recent bug 60888: Win32: support full unicode in filenames (use Wide-system calls).

Miyagawa notes some Unicode filename issues and Win32API::File without specifically mentioning long paths. However, the Win32API::File CPAN Forum entry seems to indicate only fear, which leads to anger, which leads to hate, and so on. There's an example in the Perlmonks post How to stat a file with a Unicode (UTF16-LE) filename in Windows?. It seems the Win32::CreateDirectory is the answer, and I'll try that the next time I get next to a Windows machine.

Then, supposing I can create the long path path. Now I have to teach Module::Build, and maybe other things, to handle it. That might be immediately easy with monkeypatches if Win32::GetANSIPathName() does what it says on the tin.


回答1:


Progress:

The following script works: It writes a string to a file in a directory with a long path and it is able to read back the same string. (A successful run produces no console output). I have also made a cumbersome effort to override open.

#!/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;
}

Using Win32::GetANSIPathName() with built-in open does not work: The path returned is too long.

See edit history for failed experiments.




回答2:


Following code actually creates quite deep (more than 260 characters long) directory structure. At least on my machine:

use Win32::API;

$cd = Win32::API->new('kernel32', 'CreateDirectoryW', 'PP', 'N');

$dir = '\\\\?\\c:\\!experiments';

$res = 1;

do
{
    print 'path length: ' . length($dir) . "\n";
    $dirname = pack('S*', unpack('C*', "$dir\0"));  #dirty way to produce UTF-16LE string

    $res = $cd->Call($dirname, 0);
    print "$res\n";

    $dir .= '\\abcde';

} while ( $res );



回答3:


I understand this is not a solution to your specific problem. However, there are a lot of scenarios where being able to map a very long path to a drive-letter would allow one to sidestep the issue and would therefore be useful in dealing with very long path names without having to wade through a whole lot of Windows specific code and docs.

Despite all the effort I put into figuring out how to do this, I am going to recommend somehow using SUBST. Win32::FileOp provides Subst and Unsubst. You can then map the top level working directory to an unused drive letter (which you can find by using Substed). I would start checking with Z and working backwards.

Or, you can shell out, invoke subst utility with no parameters to get a list of current substitutions, choose one that is not there.

None of this is entirely safe as substitutions could change during the build process.




回答4:


This should really be a comment but posting code in comments is hardly useful.

UNC paths do not work either:

C:\> net share
perlbuild    e:\home\src
#!/usr/bin/perl

use strict;
use warnings;

use File::Path qw(make_path);
use File::Slurp;
use Path::Class;

my $top = dir('//Computer/perlbuild');
my @comps = ('0123456789') x 30;

my $path = dir($top, @comps);

make_path $path, { verbose => 1 };

my $file = file($path, 'test.txt');

write_file "$file" => 'This is a test';

print read_file "$file";

Result:

mkdir \\Computer\perlbuild\0123456789\0123456789\0123456789\0123456789\0123456
789\0123456789\0123456789\0123456789\0123456789\0123456789\0123456789\0123456789
\0123456789\0123456789\0123456789\0123456789\0123456789\0123456789\0123456789\01
23456789\0123456789: No such file or directory; The filename or extension is too
 long at C:\Temp\k.pl line 15



回答5:


I had three thoughts, all of them kind of hacks:

  1. Start with some short directory names (C:\data_directory\a\b\c\d\4\5\6\...) and then rename the directories (starting with the deepest directory first of course).

  2. Create Windows shortcut to a moderately long path and create files and subdirectories from there? (Or install Cygwin and use symlinks?)

  3. Create the desired files in a directory with a short name, zip/tar them, and unpack them to the directory with the longer name. Or create zip/tar files "by hand" and unpack them in the desired location.



来源:https://stackoverflow.com/questions/1721807/how-do-i-create-then-use-long-windows-paths-from-perl

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!