Many moer primitives

rakudo · Nov 3, 2014 · c430c02 · c430c02
1 parent 1f42001
commit c430c02
Showing 1 changed file with 171 additions and 42 deletions.
diff --git a/src/core/IO.pm b/src/core/IO.pm
@@ -1,6 +1,6 @@
 my class Instant  { ... }
 my class IO::Dir  { ... }
-my class IO::Path { ... }
+my class IO::File  { ... }
 
 my role IO {
     method umask { state $ = :8( qx/umask/.chomp ) }
@@ -32,24 +32,24 @@ sub MAKE-ABSOLUTE-PATH($path,$abspath) {
     }
 }
 
-sub MAKE-BASENAME($abspath) {
+sub MAKE-BASENAME(Str $abspath) {
     my str $abspath_s = nqp::unbox_s($abspath);
-    my int $index     = nqp::rindex($abspath_s,'/');
-    nqp::p6bool($index == -1)
+    my int $offset    = nqp::rindex($abspath_s,'/');
+    nqp::p6bool($offset == -1)
       ?? $abspath
-      !! nqp::box_s(nqp::substr($abspath_s,$index + 1),Str);
+      !! nqp::box_s(nqp::substr($abspath_s,$offset + 1),Str);
 }
 
-sub MAKE-EXTENSION($basename) {
+sub MAKE-EXT(Str $basename) {
     my str $basename_s = nqp::unbox_s($basename);
-    my int $index      = nqp::rindex($basename_s,'.');
-    nqp::p6bool($index == -1)
+    my int $offset     = nqp::rindex($basename_s,'.');
+    nqp::p6bool($offset == -1)
       ?? ''
-      !! nqp::box_s(nqp::substr($basename_s,$index + 1),Str);
+      !! nqp::box_s(nqp::substr($basename_s,$offset + 1),Str);
 }
 
 my %CLEAN-PARTS-NUL = '..' => 1, '.' => 1, '' => 1;
-sub MAKE-CLEAN-PARTS($abspath) {
+sub MAKE-CLEAN-PARTS(Str $abspath) {
     my @parts = $abspath.split('/');
 
     # handle //unc/ on win
@@ -77,93 +77,222 @@ sub MAKE-CLEAN-PARTS($abspath) {
     @parts.push("");
 }
 
-sub FILETEST-E($abspath) {
+sub REMOVE-ROOT(Str $r, Str $p) {
+    my str $root  = nqp::unbox_s($r);
+    my str $path  = nqp::unbox_s($p);
+    my int $chars = nqp::chars($root);
+
+    return $p if $chars > nqp::chars($path);  # makes no sense
+
+    my int $i;
+    while $i < $chars && nqp::ordat($root,$i) == nqp::ordat($path,$i) {
+        $i = $i + 1;
+    }
+
+    $i ?? nqp::box_s(nqp::substr($path,$i),Str) !! $p;
+}
+
+sub COPY-FILE(Str $from, Str $to, :$createonly) {
+    if $createonly and FILETEST-E($to) {
+        fail X::IO::Copy.new(
+          :$from,
+          :$to,
+          :os-error(':createonly specified and destination exists'),
+        );
+    }
+
+    nqp::copy(nqp::unbox_s($from), nqp::unbox_s($to));
+    CATCH { default {
+        fail X::IO::Copy.new( :$from, :$to, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub RENAME-PATH(Str $from, Str $to, :$createonly) {
+    if $createonly and FILETEST-E($to) {
+        fail X::IO::Rename.new(
+          :$from,
+          :$to,
+          :os-error(':createonly specified and destination exists'),
+        );
+    }
+
+    nqp::rename(nqp::unbox_s($from), nqp::unbox_s($to));
+    CATCH { default {
+        fail X::IO::Rename.new( :$from, :$to, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub CHMOD-PATH(Str $path, Int $mode) {
+    nqp::chmod(nqp::unbox_s($path), nqp::unbox_i($mode));
+    CATCH { default {
+        fail X::IO::Chmod.new( :$path, :$mode, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub UNLINK-PATH(Str $path) {
+    nqp::unlink(nqp::unbox_s($path));
+    CATCH { default {
+        fail X::IO::Unlink.new( :$path, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub SYMLINK-PATH(Str $target, Str $name) {
+    nqp::symlink(nqp::unbox_s($name), nqp::unbox_s($target));
+    CATCH { default {
+        fail X::IO::Symlink.new( :$target, :$name, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub LINK-FILE(Str $target, Str $name) {
+    nqp::link(nqp::unbox_s($name), nqp::unbox_s($target));
+    CATCH { default {
+        fail X::IO::Link.new( :$target, :$name, :os-error(.Str) );
+    } }
+    True;
+}
+
+sub MAKE-DIR(Str $path, Int $mode) {
+    nqp::mkdir(nqp::unbox_s($path), nqp::unbox_i($mode));
+    CATCH { default {
+        fail X::IO::Mkdir.new(:$path, :$mode, os-error => .Str);
+    } }
+    True;
+}
+
+sub REMOVE-DIR(Str $path) {
+    nqp::rmdir(nqp::unbox_s($path));
+    CATCH { default {
+        fail X::IO::Rmdir.new(:$path, os-error => .Str);
+    } }
+    True;
+}
+
+sub FILETEST-E(Str $abspath) {
     nqp::p6bool( nqp::stat(nqp::unbox_s($abspath),nqp::const::STAT_EXISTS) );
 }
-sub FILETEST-D($abspath) {
+sub FILETEST-D(Str $abspath) {
     nqp::p6bool( nqp::stat(nqp::unbox_s($abspath),nqp::const::STAT_ISDIR) );
 }
-sub FILETEST-F($abspath) {
+sub FILETEST-F(Str $abspath) {
     nqp::p6bool( nqp::stat(nqp::unbox_s($abspath),nqp::const::STAT_ISREG) );
 }
-sub FILETEST-S($abspath) {
+sub FILETEST-S(Str $abspath) {
     nqp::p6box_i(nqp::stat(nqp::unbox_s($abspath),nqp::const::STAT_FILESIZE) );
 }
-sub FILETEST-L($abspath) {
+sub FILETEST-L(Str $abspath) {
     nqp::p6bool(nqp::fileislink(nqp::unbox_s($abspath)));
 }
-sub FILETEST-R($abspath) {
+sub FILETEST-R(Str $abspath) {
     nqp::p6bool(nqp::filereadable(nqp::unbox_s($abspath)));
 }
-sub FILETEST-W($abspath) {
+sub FILETEST-W(Str $abspath) {
     nqp::p6bool(nqp::filewritable(nqp::unbox_s($abspath)));
 }
-sub FILETEST-RW($abspath) {
+sub FILETEST-RW(Str $abspath) {
     my str $p = nqp::unbox_s($abspath);
     nqp::p6bool(nqp::filereadable($p) & nqp::filewritable($p));
 }
-sub FILETEST-X($abspath) {
+sub FILETEST-X(Str $abspath) {
     nqp::p6bool(nqp::fileexecutable(nqp::unbox_s($abspath)));
 }
-sub FILETEST-RWX($abspath) {
+sub FILETEST-RWX(Str $abspath) {
     my str $p = nqp::unbox_s($abspath);
     nqp::p6bool(
       nqp::filereadable($p) & nqp::filewritable($p) & nqp::fileexecutable($p)
     );
 }
-sub FILETEST-Z($abspath) {
+sub FILETEST-Z(Str $abspath) {
     nqp::p6bool(nqp::stat(nqp::unbox_s($abspath),nqp::const::STAT_FILESIZE)==0);
 }
-sub FILETEST-MODIFIED($abspath) {
+sub FILETEST-MODIFIED(Str $abspath) {
     Instant.new( nqp::p6box_i(
       nqp::stat(nqp::unbox_s($abspath), nqp::const::STAT_MODIFYTIME)
     ));
 }
-sub FILETEST-ACCESSED($abspath) {
+sub FILETEST-ACCESSED(Str $abspath) {
     Instant.new( nqp::p6box_i(
       nqp::stat(nqp::unbox_s($abspath), nqp::const::STAT_ACCESSTIME)
     ));
 }
-sub FILETEST-CHANGED($abspath) {
+sub FILETEST-CHANGED(Str $abspath) {
     Instant.new( nqp::p6box_i(
       nqp::stat(nqp::unbox_s($abspath), nqp::const::STAT_CHANGETIME)
     ));
 }
 
-sub DIR-GATHER($abspath,$test,$absolute) {
-    my $index := $abspath.chars;
-    gather {
-        for MAKE-DIR-LIST($abspath,$test) -> $elem {
-            take FILETEST-D($elem)
-              ?? IO::Dir.new(:abspath($elem ~ '/'))
-              !! IO::Path.new($absolute ?? $elem !! $elem.substr($index));
-        }
+my %FILETEST-HASH =
+  e => -> $p { True },
+  d => -> $p { nqp::p6bool(nqp::stat(nqp::unbox_s($p),nqp::const::STAT_ISDIR)) },
+  f => -> $p { nqp::p6bool(nqp::stat(nqp::unbox_s($p),nqp::const::STAT_ISREG)) },
+  s => -> $p { %FILETEST-HASH.at_key("f")($p)
+    && nqp::box_i(nqp::stat(nqp::unbox_s($p),nqp::const::STAT_FILESIZE),Int) },
+  l => -> $p { nqp::p6bool(nqp::fileislink(nqp::unbox_s($p))) },
+  r => -> $p { nqp::p6bool(nqp::filereadable(nqp::unbox_s($p))) },
+  w => -> $p { nqp::p6bool(nqp::filewritable(nqp::unbox_s($p))) },
+  x => -> $p { nqp::p6bool(nqp::fileexecutable(nqp::unbox_s($p))) },
+  z => -> $p { %FILETEST-HASH.at_key("f")($p)
+    && nqp::p6bool(nqp::stat(nqp::unbox_s($p),nqp::const::STAT_FILESIZE) == 0) },
+
+  "!e" => -> $p { False },
+  "!d" => -> $p { !%FILETEST-HASH.at_key("d")($p) },
+  "!f" => -> $p { !%FILETEST-HASH.at_key("f")($p) },
+  "!l" => -> $p { !%FILETEST-HASH.at_key("l")($p) },
+  "!r" => -> $p { !%FILETEST-HASH.at_key("r")($p) },
+  "!w" => -> $p { !%FILETEST-HASH.at_key("w")($p) },
+  "!x" => -> $p { !%FILETEST-HASH.at_key("x")($p) },
+  "!z" => -> $p { !%FILETEST-HASH.at_key("z")($p) },
+;
+
+sub FILETEST-ALL(Str $path, *@tests) {
+
+    # most common cases
+    if @tests.join -> $tests {
+        return FILETEST-R($path)   if $tests eq "r";
+        return FILETEST-RW($path)  if $tests eq "rw";
+        return FILETEST-RWX($path) if $tests eq "rwx";
     }
+
+    # nothing to check
+    else {
+        return False;
+    }
+
+    my $result = True;
+    for @tests -> $t {
+        die "Unknown test $t" unless %FILETEST-HASH.exists_key($t);
+        last unless $result = $result && %FILETEST-HASH.at_key($t)($path);
+    }
+
+    $result;
 }
 
-sub DIR-GATHER-ABSOLUTE-STR($abspath,$test) {
+sub DIR-GATHER(Str $abspath,Mu $test) {
     gather {
         for MAKE-DIR-LIST($abspath,$test) -> $elem {
             take FILETEST-D($elem)
-              ?? $elem ~ '/'
-              !! $elem;
+              ?? IO::Dir.new(:abspath($elem ~ '/'))
+              !! IO::File.new(:abspath($elem));
         }
     }
 }
 
-sub DIR-GATHER-RELATIVE-STR($abspath,$test) {
-    my $index := $abspath.chars;
+sub DIR-GATHER-STR(Str $abspath,Mu $test) {
     gather {
         for MAKE-DIR-LIST($abspath,$test) -> $elem {
             take FILETEST-D($elem)
-              ?? $elem.substr($index) ~ '/'
-              !! $elem.substr($index);
+              ?? $elem ~ '/'
+              !! $elem;
         }
     }
 }
 
 #?if moar
-sub MAKE-DIR-LIST($abspath, Mu $test) {
+sub MAKE-DIR-LIST(Str $abspath, Mu $test) {
 
     CATCH { default {
         fail X::IO::Dir.new(
@@ -202,7 +331,7 @@ sub MAKE-DIR-LIST($abspath, Mu $test) {
 #?endif
 
 #?if jvm
-sub MAKE-DIR-LIST($abspath, Mu $test) {
+sub MAKE-DIR-LIST(Str $abspath, Mu $test) {
 
     CATCH { default {
         fail X::IO::Dir.new(
@@ -240,7 +369,7 @@ sub MAKE-DIR-LIST($abspath, Mu $test) {
 #?endif
 
 #?if parrot
-sub MAKE-DIR-LIST($abspath, Mu $test) {
+sub MAKE-DIR-LIST(Str $abspath, Mu $test) {
 
     CATCH { default {
         fail X::IO::Dir.new(