--- /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
--- 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();
--- /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
--- 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__
--- /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
--- 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;
--- 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;