add files
|
1 |
package Mojo::Home; |
2 |
use Mojo::Base -base; |
|
3 |
use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1; |
|
4 | ||
5 |
use Cwd 'abs_path'; |
|
6 |
use File::Basename 'dirname'; |
|
7 |
use File::Find 'find'; |
|
8 |
use File::Spec::Functions qw(abs2rel catdir catfile splitdir); |
|
9 |
use FindBin; |
|
10 |
use Mojo::Util qw(class_to_path slurp); |
|
11 | ||
12 |
has parts => sub { [] }; |
|
13 | ||
14 |
sub new { shift->SUPER::new->parse(@_) } |
|
15 | ||
16 |
sub detect { |
|
17 |
my $self = shift; |
|
18 | ||
19 |
# Environment variable |
|
20 |
return $self->parts([splitdir(abs_path $ENV{MOJO_HOME})]) if $ENV{MOJO_HOME}; |
|
21 | ||
22 |
# Try to find home from lib directory |
|
23 |
if (my $class = @_ ? shift : 'Mojo::HelloWorld') { |
|
24 |
my $file = class_to_path $class; |
|
25 |
if (my $path = $INC{$file}) { |
|
26 |
$path =~ s/$file$//; |
|
27 |
my @home = splitdir $path; |
|
28 | ||
29 |
# Remove "lib" and "blib" |
|
30 |
pop @home while @home && ($home[-1] =~ /^b?lib$/ || $home[-1] eq ''); |
|
31 | ||
32 |
# Turn into absolute path |
|
33 |
return $self->parts([splitdir(abs_path(catdir(@home) || '.'))]); |
|
34 |
} |
|
35 |
} |
|
36 | ||
37 |
# FindBin fallback |
|
38 |
return $self->parts([split /\//, $FindBin::Bin]); |
|
39 |
} |
|
40 | ||
41 |
sub lib_dir { |
|
42 |
my $path = catdir @{shift->parts}, 'lib'; |
|
43 |
return -d $path ? $path : undef; |
|
44 |
} |
|
45 | ||
46 |
sub list_files { |
|
47 |
my ($self, $dir) = @_; |
|
48 | ||
49 |
$dir = catdir @{$self->parts}, split '/', ($dir // ''); |
|
50 |
return [] unless -d $dir; |
|
51 |
my @files; |
|
52 |
find { |
|
53 |
wanted => sub { |
|
54 |
my @parts = splitdir(abs2rel($File::Find::name, $dir)); |
|
55 |
push @files, join '/', @parts unless grep {/^\./} @parts; |
|
56 |
}, |
|
57 |
no_chdir => 1 |
|
58 |
}, $dir; |
|
59 | ||
60 |
return [sort @files]; |
|
61 |
} |
|
62 | ||
63 |
sub mojo_lib_dir { catdir(dirname(__FILE__), '..') } |
|
64 | ||
65 |
sub parse { |
|
66 |
my ($self, $path) = @_; |
|
67 |
return defined $path ? $self->parts([splitdir $path]) : $self; |
|
68 |
} |
|
69 | ||
70 |
sub rel_dir { catdir(@{shift->parts}, split '/', shift) } |
|
71 |
sub rel_file { catfile(@{shift->parts}, split '/', shift) } |
|
72 | ||
73 |
sub to_string { catdir(@{shift->parts}) } |
|
74 | ||
75 |
1; |
|
76 | ||
77 |
=encoding utf8 |
|
78 | ||
79 |
=head1 NAME |
|
80 | ||
81 |
Mojo::Home - Home sweet home! |
|
82 | ||
83 |
=head1 SYNOPSIS |
|
84 | ||
85 |
use Mojo::Home; |
|
86 | ||
87 |
# Find and manage the project root directory |
|
88 |
my $home = Mojo::Home->new; |
|
89 |
$home->detect; |
|
90 |
say $home->lib_dir; |
|
91 |
say $home->rel_file('templates/layouts/default.html.ep'); |
|
92 |
say "$home"; |
|
93 | ||
94 |
=head1 DESCRIPTION |
|
95 | ||
96 |
L<Mojo::Home> is a container for home directories. |
|
97 | ||
98 |
=head1 ATTRIBUTES |
|
99 | ||
100 |
L<Mojo::Home> implements the following attributes. |
|
101 | ||
102 |
=head2 parts |
|
103 | ||
104 |
my $parts = $home->parts; |
|
105 |
$home = $home->parts([]); |
|
106 | ||
107 |
Home directory parts. |
|
108 | ||
109 |
=head1 METHODS |
|
110 | ||
111 |
L<Mojo::Home> inherits all methods from L<Mojo::Base> and implements the |
|
112 |
following new ones. |
|
113 | ||
114 |
=head2 new |
|
115 | ||
116 |
my $home = Mojo::Home->new; |
|
117 |
my $home = Mojo::Home->new('/home/sri/myapp'); |
|
118 | ||
119 |
Construct a new L<Mojo::Home> object and L</"parse"> home directory if |
|
120 |
necessary. |
|
121 | ||
122 |
=head2 detect |
|
123 | ||
124 |
$home = $home->detect; |
|
125 |
$home = $home->detect('My::App'); |
|
126 | ||
127 |
Detect home directory from the value of the MOJO_HOME environment variable or |
|
128 |
application class. |
|
129 | ||
130 |
=head2 lib_dir |
|
131 | ||
132 |
my $path = $home->lib_dir; |
|
133 | ||
134 |
Path to C<lib> directory of application. |
|
135 | ||
136 |
=head2 list_files |
|
137 | ||
138 |
my $files = $home->list_files; |
|
139 |
my $files = $home->list_files('foo/bar'); |
|
140 | ||
141 |
Portably list all files recursively in directory relative to the home |
|
142 |
directory. |
|
143 | ||
144 |
say $home->rel_file($home->list_files('templates/layouts')->[1]); |
|
145 | ||
146 |
=head2 mojo_lib_dir |
|
147 | ||
148 |
my $path = $home->mojo_lib_dir; |
|
149 | ||
150 |
Path to C<lib> directory in which L<Mojolicious> is installed. |
|
151 | ||
152 |
=head2 parse |
|
153 | ||
154 |
$home = $home->parse('/home/sri/myapp'); |
|
155 | ||
156 |
Parse home directory. |
|
157 | ||
158 |
=head2 rel_dir |
|
159 | ||
160 |
my $path = $home->rel_dir('foo/bar'); |
|
161 | ||
162 |
Portably generate an absolute path for a directory relative to the home |
|
163 |
directory. |
|
164 | ||
165 |
=head2 rel_file |
|
166 | ||
167 |
my $path = $home->rel_file('foo/bar.html'); |
|
168 | ||
169 |
Portably generate an absolute path for a file relative to the home directory. |
|
170 | ||
171 |
=head2 to_string |
|
172 | ||
173 |
my $str = $home->to_string; |
|
174 |
my $str = "$home"; |
|
175 | ||
176 |
Home directory. |
|
177 | ||
178 |
=head1 SEE ALSO |
|
179 | ||
180 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
181 | ||
182 |
=cut |