# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1312293774 -7200
# Node ID 9416fc33d2a0b72c2d6e751a845578dc8533b592
# Parent  21a87c5f86e46b9f3538be1ad08980e964baae2f
first part (native::cd) is done

diff -r 21a87c5f86e4 -r 9416fc33d2a0 .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Tue Aug 02 16:02:54 2011 +0200
@@ -0,0 +1,3 @@
+_build
+blib
+Build
diff -r 21a87c5f86e4 -r 9416fc33d2a0 Build.PL
--- a/Build.PL	Tue Aug 02 00:21:00 2011 +0200
+++ b/Build.PL	Tue Aug 02 16:02:54 2011 +0200
@@ -4,5 +4,5 @@
 
 Module::Build->new(
     dist_name => "Fops",
-    dist_version => "0.0",
+    dist_version_from => "lib/Fops.pm",
 )->create_build_script();
diff -r 21a87c5f86e4 -r 9416fc33d2a0 lib/.perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/.perltidyrc	Tue Aug 02 16:02:54 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
diff -r 21a87c5f86e4 -r 9416fc33d2a0 lib/Fops.pm
--- a/lib/Fops.pm	Tue Aug 02 00:21:00 2011 +0200
+++ b/lib/Fops.pm	Tue Aug 02 16:02:54 2011 +0200
@@ -3,21 +3,26 @@
 use warnings;
 use Carp;
 
+our $VERSION = "0.1";
+
 sub new {
     my $class = ref $_[0] ? ref shift : shift;
     my $implementation = shift;
-    eval "require Fops::$implementation";
+    eval "require Fops::$implementation"
+      or die $@;
+
+    #"Fops::$implementation"->import("0.1");
     return "Fops::$implementation"->new(@_);
 }
 
 sub type { shift->{type} }
+sub pwd  { shift->{cwd} }
 
 sub cd {
     my $self = shift;
-    croak "method `cd' needs implementation in ".ref $self;
+    croak "method `cd' needs implementation in " . ref $self;
 }
 
-
 1
 __END__
 
diff -r 21a87c5f86e4 -r 9416fc33d2a0 lib/Fops/.perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Fops/.perltidyrc	Tue Aug 02 16:02:54 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
diff -r 21a87c5f86e4 -r 9416fc33d2a0 lib/Fops/native.pm
--- a/lib/Fops/native.pm	Tue Aug 02 00:21:00 2011 +0200
+++ b/lib/Fops/native.pm	Tue Aug 02 16:02:54 2011 +0200
@@ -1,37 +1,48 @@
 package Fops::native;
+use 5.010;
 use strict;
 use warnings;
 use Carp;
-use Cwd ();
+use Cwd qw(abs_path cwd);
 use base qw(Fops);
 
+our $VERSION = "0.0";
+
 sub new {
     my $class = ref $_[0] ? ref shift : shift;
-    my $self = bless {} => $class;
-    $self->{root} = shift;
-    $self->{type} = "native";
-
+    my $self = bless {
+        type => "native",
+        root => shift,
+        cwd  => "/",
+    } => $class;
     return $self;
 }
 
 sub cd {
     my $self = shift;
-    my $dst = shift;
+    my $dst  = shift;
+
+    $dst = $self->{cwd} .= "/$dst"
+      if $dst !~ /^\//;
 
-    if ($dst =~ /\//) {
-	$dst = Cwd::abs_path "$self->{root}/$dst";
-    }
-    else {
-	$dst = Cwd::abs_path(cwd . "/$dst");
+    my @path;
+    my @parts = grep {length} split /\// => $dst;
+    while (@parts) {
+        my $_;
+        given ($_ = pop @parts) {
+            when (".")  { }
+            when ("..") { pop @parts }
+            default { unshift @path => $_ }
+        }
     }
 
-    croak "invalid destination $dst" 
-	if not $dst =~ /^$self->{root\/}/;
+    #$self->{cwd} =~ s{/\.(?=/|$)}{}g;	# dots
+    #$self->{cwd} =~ s{/[^/]+/\.\.(?=/|$)}{}g;
+    #$self->{cwd} =~ s{/+}{/}g;
 
-    chdir $dst or croak "Can't chdir to $dst: $!";
+    $self->{cwd} = "/" . join "/" => @path;
+
+    $self;
 }
 
-sub pwd { cwd }
-
-
 1;
diff -r 21a87c5f86e4 -r 9416fc33d2a0 t/000-module.t
--- a/t/000-module.t	Tue Aug 02 00:21:00 2011 +0200
+++ b/t/000-module.t	Tue Aug 02 16:02:54 2011 +0200
@@ -12,6 +12,25 @@
 foreach (qw(type pwd cd)) {
     can_ok $fops => $_;
 }
+is($fops->pwd() => "/", "working dir is /");
+
+my @dir = (
+    "////" => "/",
+    "/.//./" => "/",
+    "/.//./." => "/",
+    "././/./." => "/",
+    "/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;
+
+    ok($fops->cd($dir), "cd $dir");
+    is($fops->pwd(), $pwd, "pwd should be $pwd");
+}
 
 
 done_testing;