TL;DR

Here we are with TASK #1 from the Perl Weekly Challenge #112. Enjoy!

# The challenge

You are given a string path, starting with a slash ‘/’.

Write a script to convert the given absolute path to the simplified canonical path.

In a Unix-style file system:

• A period ‘.’ refers to the current directory
• A double period ‘..’ refers to the directory up a level
• Multiple consecutive slashes (‘//’) are treated as a single slash ‘/’

The canonical path format:

• The path starts with a single slash ‘/’.
• Any two directories are separated by a single slash ‘/’.
• The path does not end with a trailing ‘/’.
• The path only contains the directories on the path from the root directory to the target file or directory

Example

Input: "/a/"
Output: "/a"

Input: "/a/b//c/"
Output: "/a/b/c"

Input: "/a/b/c/../.."
Output: "/a"


# The questions

As an amateur nitpicker, I would argue that the sentence The path does not end with a trailing ‘/’ is preetty inaccurate, because there might well be an occasion where the trailing slash is needed… that is the filesystem root /.

Anyway, apart from this the instructions are quite clear, so let’s get to the business!

# The solution

Here is my solution:

sub canonical_path ($p) {$p =~ s{/\K(?:\.?/)+}{}gmxs;
$p =~ s{\A/.*\K/\z}{}mxs; 1 while$p =~ s{/[^/]+/\.\.(/|\z)}{$1}mxs; return$p;
}


I know, I know… now I have two problems. Well… two challenges.

Anyway:

• the first substitution takes care of removing all consecutive slashes, or groups pointing to the same directory as the previous one (e.g. as in /a/./b', removing the './ part);
• the second substitution removes the trailing slash, if any;
• the third substitution removes all the up a directory parts.

Seems to be working:

$perl perl/ch-1.pl ok 1 - /a/ ok 2 - /a//b/c/ ok 3 - /a/b/c/../.. ok 4 - /a/b/c/../../ ok 5 - /a/./b/.//./c/../../ ok 6 - /a/../../../b/ 1..6  The whole program is: #!/usr/bin/env perl use 5.024; use warnings; use experimental qw< postderef signatures >; no warnings qw< experimental::postderef experimental::signatures >; use Test::More; sub canonical_path ($p) {
$p =~ s{/\K(?:\.?/)+}{}gmxs;$p =~ s{\A/.*\K/\z}{}mxs;
1 while $p =~ s{/[^/]+/\.\.(/|\z)}{$1}mxs;
return $p; } for my$test(
[qw< /a/ /a >],
[qw< /a//b/c/ /a/b/c >],
[qw< /a/b/c/../.. /a >],
[qw< /a/b/c/../../ /a >],
[qw< /a/./b/.//./c/../../ /a >],
[qw< /a/../../../b/ /b >],
) {
my ($input,$expected) = $test->@*; my$got = canonical_path($input); is$got, $expected,$input;
}

done_testing;


Stay safe folks!