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

微笑、不失礼 提交于 2019-11-27 20:35:01
Sinan Ünür

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.

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 );

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.

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

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.

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