1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
use strict;
use warnings;
package App::Perlbrew::Path;
use File::Basename ();
use File::Glob ();
use File::Path ();
use overload (
'""' => \& stringify,
fallback => 1,
);
sub _joinpath {
for my $entry (@_) {
no warnings 'uninitialized';
die 'Received an undefined entry as a parameter (all parameters are: '. join(', ', @_). ')' unless (defined($entry));
}
return join "/", @_;
}
sub _child {
my ($self, $package, @path) = @_;
$package->new($self->{path}, @path);
}
sub _children {
my ($self, $package) = @_;
map { $package->new($_) } File::Glob::bsd_glob($self->child("*"));
}
sub new {
my ($class, @path) = @_;
bless { path => _joinpath (@path) }, $class;
}
sub exists {
my ($self) = @_;
-e $self->stringify;
}
sub basename {
my ($self, $suffix) = @_;
return scalar File::Basename::fileparse($self, ($suffix) x!! defined $suffix);
}
sub child {
my ($self, @path) = @_;
return $self->_child(__PACKAGE__, @path);
}
sub children {
my ($self) = @_;
return $self->_children(__PACKAGE__);
}
sub dirname {
my ($self) = @_;
return App::Perlbrew::Path->new( File::Basename::dirname($self) );
}
sub mkpath {
my ($self) = @_;
File::Path::mkpath( [$self->stringify], 0, 0777 );
return $self;
}
sub readlink {
my ($self) = @_;
my $link = CORE::readlink( $self->stringify );
$link = __PACKAGE__->new($link) if defined $link;
return $link;
}
sub rmpath {
my ($self) = @_;
File::Path::rmtree( [$self->stringify], 0, 0 );
return $self;
}
sub stringify {
my ($self) = @_;
return $self->{path};
}
sub stringify_with_tilde {
my ($self) = @_;
my $path = $self->stringify;
my $home = $ENV{HOME};
$path =~ s!\Q$home/\E!~/! if $home;
return $path;
}
sub symlink {
my ($self, $destination, $force) = @_;
$destination = App::Perlbrew::Path->new($destination) unless ref $destination;
CORE::unlink($destination) if $force && (-e $destination || -l $destination);
$destination if CORE::symlink($self, $destination);
}
sub unlink {
my ($self) = @_;
CORE::unlink($self);
}
1;
|
