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

Windows has two separate system call for each function that needs to deal with strings, an "A" call using the ANSI aka Active Code Page as the encoding (e.g. cp1252) and a "W" call using UTF-16le. Perl uses "A" calls, while \\?\ only works with "W" calls.

You can use Win32::API to access the "W" calls as shown in the script below, but Win32::LongPath not only uses the "W" calls, but automatically adds \\?\!

Example of using Win32::API to call CreateDirectoryW to use a long path (\\?\-prefixed path):

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

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