Permalink
Browse files

Merge branch 'iospec' of https://github.com/labster/rakudo into nom

  • Loading branch information...
moritz committed May 4, 2013
2 parents 4741028 + 02c7fbb commit 5838e933b362d33c8a0854a7c410c347a4911bde
Showing with 561 additions and 23 deletions.
  1. +0 −1 src/RESTRICTED.setting
  2. +58 −18 src/core/IO.pm
  3. +55 −0 src/core/IO/Spec.pm
  4. +50 −0 src/core/IO/Spec/Cygwin.pm
  5. +174 −0 src/core/IO/Spec/Unix.pm
  6. +213 −0 src/core/IO/Spec/Win32.pm
  7. +3 −0 src/core/terms.pm
  8. +8 −4 tools/build/Makefile.in
View
@@ -18,7 +18,6 @@ my class RESTRICTED is Mu {
method gist(|) { restricted(self.^name) }
}
my class IO is RESTRICTED { }
my class IO::Handle is RESTRICTED { }
my class IO::Socket is RESTRICTED { }
View
@@ -1,6 +1,4 @@
my role IO { }
my class X::IO::Copy { ... }
my class X::IO::Dir { ... }
sub print(|) {
my $args := pir::perl6_current_args_rpa__P();
@@ -218,7 +216,6 @@ my class IO::Handle does IO::FileTestable {
$! ?? fail(X::IO::Copy.new(from => $.path, to => $dest, os-error => ~$!)) !! True
}
my class X::IO::Chmod { ... }
method chmod($mode) {
nqp::chmod(nqp::unbox_s(~$.path), nqp::unbox_i($mode.Int));
return True;
@@ -246,6 +243,7 @@ my class IO::Handle does IO::FileTestable {
}
my class IO::Path is Cool does IO::FileTestable {
method SPEC { IO::Spec.MODULE };
has Str $.basename;
has Str $.directory = '.';
has Str $.volume = '';
@@ -259,17 +257,14 @@ my class IO::Path is Cool does IO::FileTestable {
}
multi method new(Str:D $path) {
my @chunks = $path.split('/');
my $basename = @chunks.pop;
my $directory = @chunks ?? @chunks.join('/') !! '.';
self.new(:$basename, :$directory, :volume(""));
self.new( |$.SPEC.split($path).hash );
}
multi method Str(IO::Path:D:) {
$.directory eq '.' ?? $.basename !! join('/', $.directory, $.basename);
$.SPEC.join($.volume, $.directory, $.basename);
}
multi method gist(IO::Path:D:) {
"{self.^name}<{self.basename}>";
"{self.^name}<{self.Str}>";
}
multi method Numeric(IO::Path:D:) {
self.basename.Numeric;
@@ -294,19 +289,72 @@ my class IO::Path is Cool does IO::FileTestable {
method contents(IO::Path:D: *%opts) {
dir(~self, |%opts);
}
method is-absolute {
$.SPEC.is-absolute(~self);
}
method is-relative {
! $.SPEC.is-absolute(~self);
}
method absolute ($base = $*CWD) {
return self.new($.SPEC.rel2abs(~self, $base))
}
method relative ($relative_to_directory = $*CWD) {
return self.new($.SPEC.abs2rel(~self, $relative_to_directory));
}
method cleanup {
return self.new($.SPEC.canonpath(~self));
}
method resolve {
fail "Not Yet Implemented: requires readlink()";
}
method parent {
if self.is-absolute {
return self.new($.SPEC.join($.volume, $.directory, ''));
}
elsif all($.basename, $.directory) eq $.SPEC.curdir {
return self.new(:$.volume, directory=>$.SPEC.curdir,
basename=>$.SPEC.updir);
}
elsif $.basename eq $.SPEC.updir && $.directory eq $.SPEC.curdir
or !grep({$_ ne $.SPEC.updir}, $.SPEC.splitdir($.directory)) {
return self.new( # If all updirs, then add one more
:$.volume,
directory => $.SPEC.catdir($.directory, $.SPEC.updir),
:$.basename );
}
else {
return self.new( $.SPEC.join($.volume, $.directory, '') );
}
}
method child ($childname) {
self.new($.SPEC.join: $.volume,
$.SPEC.catdir($.directory, $.basename),
$childname);
}
}
my class IO::Path::Unix is IO::Path { method SPEC { IO::Spec::Unix }; }
my class IO::Path::Win32 is IO::Path { method SPEC { IO::Spec::Win32 }; }
my class IO::Path::Cygwin is IO::Path { method SPEC { IO::Spec::Cygwin }; }
sub dir(Cool $path = '.', Mu :$test = none('.', '..')) {
my Mu $RSA := pir::new__PS('OS').readdir(nqp::unbox_s($path.Str));
my int $elems = nqp::elems($RSA);
my @res;
my ($directory, $volume) = IO::Spec.splitpath(~$path, :nofile);
loop (my int $i = 0; $i < $elems; $i = $i + 1) {
my Str $file := nqp::p6box_s(pir::trans_encoding__Ssi(
nqp::atpos_s($RSA, $i),
pir::find_encoding__Is('utf8')));
if $file ~~ $test {
#this should be like IO::Path.child(:basename($file)) because of :volume
@res.push: IO::Path.new(:basename($file), :directory($path.Str), :volume(""));
@res.push: IO::Path.new(:basename($file), :$directory, :$volume);
}
}
return @res.list;
@@ -321,7 +369,6 @@ sub dir(Cool $path = '.', Mu :$test = none('.', '..')) {
}
}
my class X::IO::Unlink { ... }
sub unlink($path) {
nqp::unlink($path);
return True;
@@ -335,7 +382,6 @@ sub unlink($path) {
}
}
my class X::IO::Rmdir { ... }
sub rmdir($path) {
nqp::rmdir($path);
return True;
@@ -423,7 +469,6 @@ multi sub spurt(Cool $filename,
$fh.close;
}
my class X::IO::Cwd { ... }
proto sub cwd(|) { * }
multi sub cwd() {
return nqp::p6box_s(
@@ -441,7 +486,6 @@ multi sub cwd() {
}
my class X::IO::Chdir { ... }
proto sub chdir(|) { * }
multi sub chdir($path as Str) {
nqp::chdir(nqp::unbox_s($path));
@@ -457,7 +501,6 @@ multi sub chdir($path as Str) {
}
}
my class X::IO::Mkdir { ... }
proto sub mkdir(|) { * }
multi sub mkdir($path as Str, $mode = 0o777) {
nqp::mkdir($path, $mode);
@@ -479,7 +522,6 @@ $PROCESS::ERR = IO::Handle.new;
nqp::bindattr(nqp::p6decont($PROCESS::ERR),
IO::Handle, '$!PIO', nqp::getstderr());
my class X::IO::Rename { ... }
sub rename(Cool $from as Str, Cool $to as Str) {
nqp::rename(nqp::unbox_s($from), nqp::unbox_s($to));
return True;
@@ -510,8 +552,6 @@ sub copy(Cool $from as Str, Cool $to as Str) {
}
}
}
my class X::IO::Symlink { ... }
my class X::IO::Link { ... }
sub symlink(Cool $target as Str, Cool $name as Str) {
nqp::symlink(nqp::unbox_s($target), nqp::unbox_s($name));
return True;
View
@@ -0,0 +1,55 @@
my class IO::Spec {
my %module = (
'MSWin32' => 'Win32',
'os2' => 'Win32',
'dos' => 'Win32',
'symbian' => 'Win32',
'NetWare' => 'Win32',
'Win32' => 'Win32',
'cygwin' => 'Cygwin',
'Cygwin' => 'Cygwin',
# <MacOS Mac> »=>» 'Mac',
# 'VMS' => 'VMS'
);
# this is really just a way of getting $*OS when it's not in scope yet
my $submodule = %module{ nqp::atkey(nqp::atpos(pir::getinterp__P, pir::const::IGLOBALS_CONFIG_HASH), 'osname') };
my $SPEC := IO::Spec.WHO{ $submodule // 'Unix' };
method FSTYPE ($OS = $*OS) { %module{$OS} // 'Unix' }
#| Dispatches methods to the appropriate class for the current $*OS
#| Well, it should, if handles worked here. Still useful, though.
method MODULE
# handles
# <canonpath curdir updir rootdir devnull tmpdir
# is-absolute no-parent-or-current-test
# path split join splitpath catpath catfile
# splitdir catdir abs2rel rel2abs>
{ $SPEC }
#| Returns a copy of the module for the given OS string
#| e.g. IO::Spec.os('Win32') returns IO::Spec::Win32
method os (Str $OS = $*OS) {
IO::Spec.WHO{%module{$OS} // 'Unix'};
}
method canonpath( |c ) { $SPEC.canonpath( |c ) }
method curdir { $SPEC.curdir() }
method updir { $SPEC.updir() }
method rootdir { $SPEC.rootdir() }
method devnull { $SPEC.devnull() }
method tmpdir { $SPEC.tmpdir() }
method is-absolute( |c ) { $SPEC.is-absolute( |c ) }
method no-parent-or-current-test { $SPEC.no-parent-or-current-test }
method path { $SPEC.path() }
method split ( |c ) { $SPEC.split( |c ) }
method join ( |c ) { $SPEC.join( |c ) }
method splitpath( |c ) { $SPEC.splitpath( |c ) }
method catpath( |c ) { $SPEC.catpath( |c ) }
method catfile( |c ) { $SPEC.catfile( |c ) }
method splitdir( |c ) { $SPEC.splitdir( |c ) }
method catdir( |c ) { $SPEC.catdir( |c ) }
method abs2rel( |c ) { $SPEC.abs2rel( |c ) }
method rel2abs( |c ) { $SPEC.rel2abs( |c ) }
}
View
@@ -0,0 +1,50 @@
my class IO::Spec::Cygwin is IO::Spec::Unix {
#| Any C<\> (backslashes) are converted to C</> (forward slashes),
#| and then IO::Spec::Unix.canonpath() is called on the result.
method canonpath (Cool:D $path is copy) {
$path.=subst(:g, '\\', '/');
# Handle network path names beginning with double slash
my $node = '';
if $path ~~ s/^ ('//' <-[/]>+) [ '/' | $ ] /\// { #/
$node = ~$0;
}
$node ~ IO::Spec::Unix.canonpath($path);
}
#| Calls the Unix version, and additionally prevents
#| accidentally creating a //network/path.
method catdir ( *@paths ) {
my $result = IO::Spec::Unix.catdir(@paths);
# Don't create something that looks like a //network/path
$result.subst(/ <[\\\/]> ** 2..*/, '/');
}
#| Tests if the file name begins with C<drive_letter:/> or a slash.
method is-absolute ($file) {
so $file ~~ / ^ [<[A..Z a..z]> ':']? <[\\/]>/; # C:/test
}
method tmpdir {
state $tmpdir;
return $tmpdir if $tmpdir.defined;
$tmpdir = self.canonpath: first( { .defined && .IO.d && .IO.w },
%*ENV<TMPDIR>,
"/tmp",
%*ENV<TMP>,
%*ENV<TEMP>,
'C:/temp')
|| self.curdir;
}
# Paths might have a volume, so we use Win32 splitpath and catpath instead
method splitpath (|c) { IO::Spec::Win32.splitpath(|c) }
method catpath (|c) { IO::Spec::Win32.catpath(|c).subst(:global, '\\', '/') }
method split ($path) { IO::Spec::Win32.split($path).map:
{ (.key => .value.subst(:global, '\\', '/')) } }
method join (|c) { IO::Spec::Win32.join(|c).subst(:global, '\\', '/') }
}
Oops, something went wrong.

0 comments on commit 5838e93

Please sign in to comment.