Permalink
Browse files

Unix.canonpath done

  • Loading branch information...
1 parent dc8606a commit 8606562c1bab5ec929c19f46e7c32da65b447a90 @FROGGS committed Sep 14, 2012
Showing with 42 additions and 5 deletions.
  1. +1 −1 README.md
  2. +1 −1 lib/File/Spec.pm
  3. +23 −2 lib/File/Spec/Unix.pm
  4. +17 −1 t/01_unix.t
View
@@ -9,7 +9,7 @@ Usage:
Methods (current state):
Unix Mac OS2 Win32 VMS
- canonpath
+ canonpath done
catdir
catfile
curdir done done done
View
@@ -18,7 +18,7 @@ my $module = "File::Spec::" ~ ($module{$*OS} // 'Unix');
require $module;
class File::Spec {
- method canonpath { ::($module).canonpath() }
+ method canonpath( $path ) { ::($module).canonpath( $path ) }
method catdir { ::($module).catdir() }
method catfile { ::($module).catfile() }
method curdir { ::($module).curdir() }
View
@@ -2,8 +2,29 @@
module File::Spec::Unix;
class File::Spec::Unix {
- method canonpath {
-
+ method canonpath( $path is copy ) {
+ return unless $path.defined;
+
+ # Handle POSIX-style node names beginning with double slash (qnx, nto)
+ # (POSIX says: "a pathname that begins with two successive slashes
+ # may be interpreted in an implementation-defined manner, although
+ # more than two leading slashes shall be treated as a single slash.")
+ my $node = '';
+ my $double_slashes_special = $*OS eq 'qnx' || $*OS eq 'nto';
+
+
+ if $double_slashes_special
+ && ( $path ~~ s[^(\/\/<-[\/]>+)\/?$] = '' || $path ~~ s[^(\/\/<-[\/]>+)\/] = '/' ) {
+ $node = $0;
+ }
+
+ $path ~~ s:g[\/+] = '/'; # xx////xx -> xx/xx
+ $path ~~ s:g[[\/\.]+[\/|$]] = '/'; # xx/././xx -> xx/xx
+ $path ~~ s[^[\.\/]+] = '' unless $path eq "./"; # ./xx -> xx
+ $path ~~ s[^\/[\.\.\/]+] = '/'; # /../../xx -> xx
+ $path ~~ s[^\/\.\.$] = '/'; # /.. -> /
+ $path ~~ s[\/$] = '' unless $path eq "/"; # xx/ -> xx
+ return "$node$path";
}
method catdir {
View
@@ -3,13 +3,29 @@ use lib 'lib';
use Test;
use File::Spec;
-plan 4;
+plan 14;
if $*OS ~~ any(<MacOS MSWin32 os2 VMS epoc NetWare symbian dos cygwin>) {
skip_rest 'this is not Unix\'ish'
}
else {
#canonpath
+ my %canonpath = (
+ '///../../..//./././a//b/.././c/././' => '/a/b/../c',
+ '' => '',
+ 'a/../../b/c' => 'a/../../b/c',
+ '/.' => '/',
+ '/./' => '/',
+ '/a/./' => '/a',
+ '/a/.' => '/a',
+ '/../../' => '/',
+ '/../..' => '/',
+ '/..' => '/',
+ );
+ for %canonpath.kv -> $get, $want {
+ is File::Spec.canonpath( $get ), $want, "canonpath: '$get' -> '$want'";
+ }
+
#catdir
#catfile
is File::Spec.curdir, '.', 'curdir is "."';

0 comments on commit 8606562

Please sign in to comment.