lib/Fops/native.pm
changeset 1 9416fc33d2a0
parent 0 21a87c5f86e4
child 2 1bd03bcf26b4
--- 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;