equal
deleted
inserted
replaced
1 package Fops::native; |
1 package Fops::native; |
|
2 use 5.010; |
2 use strict; |
3 use strict; |
3 use warnings; |
4 use warnings; |
4 use Carp; |
5 use Carp; |
5 use Cwd (); |
6 use Cwd qw(abs_path cwd); |
6 use base qw(Fops); |
7 use base qw(Fops); |
|
8 |
|
9 our $VERSION = "0.0"; |
7 |
10 |
8 sub new { |
11 sub new { |
9 my $class = ref $_[0] ? ref shift : shift; |
12 my $class = ref $_[0] ? ref shift : shift; |
10 my $self = bless {} => $class; |
13 my $self = bless { |
11 $self->{root} = shift; |
14 type => "native", |
12 $self->{type} = "native"; |
15 root => shift, |
13 |
16 cwd => "/", |
|
17 } => $class; |
14 return $self; |
18 return $self; |
15 } |
19 } |
16 |
20 |
17 sub cd { |
21 sub cd { |
18 my $self = shift; |
22 my $self = shift; |
19 my $dst = shift; |
23 my $dst = shift; |
20 |
24 |
21 if ($dst =~ /\//) { |
25 $dst = $self->{cwd} .= "/$dst" |
22 $dst = Cwd::abs_path "$self->{root}/$dst"; |
26 if $dst !~ /^\//; |
23 } |
27 |
24 else { |
28 my @path; |
25 $dst = Cwd::abs_path(cwd . "/$dst"); |
29 my @parts = grep {length} split /\// => $dst; |
|
30 while (@parts) { |
|
31 my $_; |
|
32 given ($_ = pop @parts) { |
|
33 when (".") { } |
|
34 when ("..") { pop @parts } |
|
35 default { unshift @path => $_ } |
|
36 } |
26 } |
37 } |
27 |
38 |
28 croak "invalid destination $dst" |
39 #$self->{cwd} =~ s{/\.(?=/|$)}{}g; # dots |
29 if not $dst =~ /^$self->{root\/}/; |
40 #$self->{cwd} =~ s{/[^/]+/\.\.(?=/|$)}{}g; |
|
41 #$self->{cwd} =~ s{/+}{/}g; |
30 |
42 |
31 chdir $dst or croak "Can't chdir to $dst: $!"; |
43 $self->{cwd} = "/" . join "/" => @path; |
|
44 |
|
45 $self; |
32 } |
46 } |
33 |
47 |
34 sub pwd { cwd } |
|
35 |
|
36 |
|
37 1; |
48 1; |