# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1312297968 -7200
# Node ID 1bd03bcf26b4bff4b053f101a6659a0820246a5e
# Parent  9416fc33d2a0b72c2d6e751a845578dc8533b592
implemented is_dir() is_file() mkpath()

diff -r 9416fc33d2a0 -r 1bd03bcf26b4 lib/Fops.pm
--- a/lib/Fops.pm	Tue Aug 02 16:02:54 2011 +0200
+++ b/lib/Fops.pm	Tue Aug 02 17:12:48 2011 +0200
@@ -1,7 +1,10 @@
 package Fops;
+use 5.010;
 use strict;
 use warnings;
 use Carp;
+use base qw(Exporter);
+our @EXPORT_OK = qw(_path);
 
 our $VERSION = "0.1";
 
@@ -17,12 +20,38 @@
 
 sub type { shift->{type} }
 sub pwd  { shift->{cwd} }
+sub root { shift->{root} }
 
 sub cd {
     my $self = shift;
     croak "method `cd' needs implementation in " . ref $self;
 }
 
+sub stat {
+    my $self = shift;
+    croak "method `stat` needs implementation in " . ref $self;
+}
+
+sub _path {
+    my @parts = grep {length} split /\// => join "/", @_;
+    my @path;
+
+    while (@parts) {
+        my $_;
+        given ($_ = pop @parts) {
+            when (".")  { }
+            when ("..") { pop @parts }
+            default { unshift @path => $_ }
+        }
+    }
+
+    #$self->{cwd} =~ s{/\.(?=/|$)}{}g;	# dots
+    #$self->{cwd} =~ s{/[^/]+/\.\.(?=/|$)}{}g;
+    #$self->{cwd} =~ s{/+}{/}g;
+
+    return "/" . join "/" => @path;
+}
+
 1
 __END__
 
diff -r 9416fc33d2a0 -r 1bd03bcf26b4 lib/Fops/native.pm
--- a/lib/Fops/native.pm	Tue Aug 02 16:02:54 2011 +0200
+++ b/lib/Fops/native.pm	Tue Aug 02 17:12:48 2011 +0200
@@ -5,6 +5,8 @@
 use Carp;
 use Cwd qw(abs_path cwd);
 use base qw(Fops);
+use File::Path ();
+use Fops qw(_path);
 
 our $VERSION = "0.0";
 
@@ -25,24 +27,27 @@
     $dst = $self->{cwd} .= "/$dst"
       if $dst !~ /^\//;
 
-    my @path;
-    my @parts = grep {length} split /\// => $dst;
-    while (@parts) {
-        my $_;
-        given ($_ = pop @parts) {
-            when (".")  { }
-            when ("..") { pop @parts }
-            default { unshift @path => $_ }
-        }
-    }
+    $self->{cwd} = _path($dst);
+}
+
+sub stat {
+    my $self = shift;
+    stat(_path($self->{root}, shift));
+}
 
-    #$self->{cwd} =~ s{/\.(?=/|$)}{}g;	# dots
-    #$self->{cwd} =~ s{/[^/]+/\.\.(?=/|$)}{}g;
-    #$self->{cwd} =~ s{/+}{/}g;
+sub is_dir {
+    my $self = shift;
+    -d _path($self->{root}, shift);
+}
 
-    $self->{cwd} = "/" . join "/" => @path;
+sub is_file {
+    my $self = shift;
+    -f _path($self->{root}, shift);
+}
 
-    $self;
+sub mkpath {
+    my $self = shift;
+    File::Path::mkpath([ map { _path($self->{root}, $_) } @_ ]);
 }
 
 1;
diff -r 9416fc33d2a0 -r 1bd03bcf26b4 t/000-module.t
--- a/t/000-module.t	Tue Aug 02 16:02:54 2011 +0200
+++ b/t/000-module.t	Tue Aug 02 17:12:48 2011 +0200
@@ -1,18 +1,22 @@
 use strict;
 use warnings;
 use Test::More;
+use File::Temp;
+
+my $dir = File::Temp->newdir();
 
 use_ok "Fops";
 
-my $fops = Fops->new(native => "/tmp");
+my $fops = Fops->new(native => $dir);
 isa_ok($fops => "Fops");
 isa_ok($fops => "Fops::native");
 is($fops->type => "native", "type is native");
 
-foreach (qw(type pwd cd)) {
+foreach (qw(type pwd cd stat)) {
     can_ok $fops => $_;
 }
 is($fops->pwd() => "/", "working dir is /");
+is($fops->root() => $dir, "root is $dir");
 
 my @dir = (
     "////" => "/",
@@ -21,16 +25,27 @@
     "././/./." => "/",
     "/a/b/c/d/" => "/a/b/c/d",
     "/a/b/c/d" => "/a/b/c/d",
-    ".."       => "/a/b/c",
+    ".."       => "/",
 );
 
 while (@dir) {
     my $dir = shift @dir;
     my $pwd = shift @dir;
+    is(Fops::_path($dir) => $pwd, "canonical $dir");
+}
+is(Fops::_path(qw(/a b c)) => "/a/b/c", "canonical /a/b/c");
 
-    ok($fops->cd($dir), "cd $dir");
-    is($fops->pwd(), $pwd, "pwd should be $pwd");
-}
+
+ok($fops->stat("/"), "stat /");
+ok($fops->is_dir("/"), "is dir /");
+
+ok($fops->mkpath("a"), "mkpath a");
+ok($fops->is_dir("/a"), "dir /a");
+
+ok($fops->mkpath("/x/y/z", "/a/b/c"), "dirs");
+ok($fops->is_dir("/x/y/z"), "dir /x/y/z");
+ok($fops->is_dir("/a/b/c"), "dir /a/b/c");
+
 
 
 done_testing;