--- 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;