Как создать, затем использовать длинные пути Windows из Perl?

Ответ 1

Прогресс:

Работает следующий script: он записывает строку в файл в каталоге с длинным путем и может считывать одну и ту же строку. (Успешный запуск не дает консольного вывода). Я также сделал громоздкую попытку переопределить 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(*;[email protected]) {
    $_[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;
}

Использование Win32::GetANSIPathName() со встроенным open не работает: Возвращенный путь слишком длинный.

Смотрите историю изменений для неудачных экспериментов.

Ответ 2

Следующий код фактически создает довольно глубокую (более 260 символов) структуру каталогов. По крайней мере, на моей машине:

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

Я понимаю, что это не решение вашей конкретной проблемы. Тем не менее, существует множество сценариев, когда возможность сопоставить очень длинный путь к букве диска позволит обойти проблему и поэтому будет полезна при работе с очень длинными именами путей, не пропуская через много Конкретный код и документы Windows.

Несмотря на все усилия, которые я придумал, как это сделать, я как-то порекомендую использовать SUBST. Win32::FileOp предоставляет SUBST и Unsubst. Затем вы можете сопоставить рабочий каталог верхнего уровня с неиспользуемой буквой диска (которую вы можете найти, используя Substed). Я бы начал проверять с помощью Z и работать в обратном направлении.

Или вы можете отключить, вызвать утилиту SUBST без параметров, чтобы получить список текущих подстановок, выбрать тот, который там не существует.

Ничто из этого не является полностью безопасным, поскольку замены могут меняться в процессе сборки.

Ответ 4

Это действительно должно быть комментарий, но комментарий в комментариях вряд ли будет полезен.

Пути UNC тоже не работают:

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

Результат:

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

У меня было три мысли, все они вроде хаков:

• Начните с коротких имен каталогов (C:\data_directory\a\b\c\d\4\5\6 \...), а затем переименуйте каталоги (начиная с самого глубокого каталога сначала, конечно).

• Создать ярлык Windows для умеренно длинного пути и создать файлы и подкаталоги оттуда? (Или установить Cygwin и использовать символические ссылки?)

• Создайте нужные файлы в каталоге с коротким именем, zip/tar и распакуйте их в каталог с более длинным именем. Или создайте файлы zip/tar "вручную" и распакуйте их в нужном месте.