Created
July 18, 2024 17:08
-
-
Save hakonhagland/240e2407e9ebf8a11125a63c4c772d88 to your computer and use it in GitHub Desktop.
Check long path names with perl and MSYS install.exe on windows 11
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| use feature qw(say); | |
| use strict; | |
| use warnings; | |
| use File::Spec::Functions qw(catfile catdir splitdir); | |
| use File::Basename; | |
| use Win32::LongPath; | |
| # Define paths | |
| my $msys_path = 'C:\Strawberry\perl\site\lib\auto\share\dist\Alien-MSYS\msys\1.0\bin'; | |
| my $install_exe = catfile($msys_path, 'install.exe'); | |
| my $base_path = 'C:\LongPathTest'; | |
| # Function to create directories recursively | |
| sub create_directories_recursively { | |
| my ($path) = @_; | |
| my @parts = splitdir($path); | |
| my $current_path = shift @parts; # Start with the drive letter or base path | |
| $current_path .= "\\" if $current_path =~ /^[a-zA-Z]:$/; | |
| foreach my $part (@parts) { | |
| next if $part eq ''; # Skip empty parts | |
| $current_path = catdir($current_path, $part); | |
| my $long_current_path = '\\\\?\\' . $current_path; | |
| unless (Win32::LongPath::mkdirL($long_current_path)) { | |
| die "Cannot create directory '$long_current_path': $^E" unless $^E == 183; # 183 means directory already exists | |
| } | |
| } | |
| } | |
| # Create a test file | |
| my $test_file = catfile($base_path, 'testfile.txt'); | |
| open my $fh, '>', $test_file or die "Cannot open test file: $!"; | |
| print $fh "This is a test file."; | |
| close $fh; | |
| # Function to test a specific directory name length | |
| sub test_directory_length { | |
| my ($length) = @_; | |
| my $shorter_path = $base_path; | |
| for my $i (1..10) { # Adjust the number of iterations as needed | |
| $shorter_path = catdir($shorter_path, 'a' x $length); | |
| } | |
| create_directories_recursively($shorter_path); | |
| my $dest_path = catfile($shorter_path, 'testfile.txt'); | |
| my $command = "\"$install_exe\" -c \"$test_file\" \"$dest_path\""; | |
| system($command) == 0 or return 0; # Return 0 if the command fails | |
| my $long_dest_path = '\\\\?\\' . $dest_path; | |
| return Win32::LongPath::testL('e', $long_dest_path) ? 1 : 0; # Return 1 if the file exists | |
| } | |
| # Test directory name lengths | |
| # NOTE: On my system with Windows 11 and perl version 5.38, the test fails with directory name lengths of 23,24, and 25 | |
| for my $length (22..25) { | |
| say "Testing with directory name length: $length"; | |
| if (test_directory_length($length)) { | |
| say "Success with directory name length: $length"; | |
| } else { | |
| say "Failure with directory name length: $length"; | |
| } | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment