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