File Coverage

blib/lib/Mojolicious/Plugin/DirectoryServer.pm
Criterion Covered Total %
statement 95 95 100.0
branch 34 36 94.4
condition 19 25 76.0
subroutine 14 14 100.0
pod 1 6 16.6
total 163 176 92.6


line stmt bran cond sub pod time code
1 9     9   10046783 use v5.32;
  9         42  
2              
3             package Mojolicious::Plugin::DirectoryServer;
4              
5             our $VERSION = '1.005';
6              
7 9     9   65 use Cwd ();
  9         20  
  9         212  
8 9     9   63 use Encode ();
  9         19  
  9         314  
9 9     9   5173 use DirHandle;
  9         9374  
  9         454  
10 9     9   828 use Mojo::Base qw( Mojolicious::Plugin -signatures );
  9         14698  
  9         80  
11 9     9   29568 use Mojo::JSON qw(encode_json);
  9         234745  
  9         793  
12 9     9   820 use Mojolicious::Types;
  9         46779  
  9         113  
13              
14             # Stolen from Plack::App::Direcotry
15             my $dir_page = <<'PAGE';
16            
17             Index of <%= $cur_path %>
18            
19            
26            
27            
28            

Index of <%= $cur_path %>
29            
30            
31            
32             Name
33             Size
34             Type
35             Last Modified
36            
37             % for my $file (@$files) { my $css_type = $file->{type} =~ s/;.*//r; $css_type =~ s|/|-|g;
38            
39             <%== $file->{name} %>
40             <%= $file->{size} %>
41             <%= $file->{type} %>
42             <%= $file->{mtime} %>
43            
44             % }
45            
46            
47            
48             PAGE
49              
50             my $types = Mojolicious::Types->new;
51              
52             sub register {
53 8     8 1 617 my ( $self, $app, $args ) = @_;
54              
55 8   66     166 my $root = Mojo::Home->new( $args->{root} || Cwd::getcwd );
56 8         233 my $handler = $args->{handler};
57 8         58 my $index = $args->{dir_index};
58 8   100     77 my $auto_index = $args->{auto_index} // 1;
59 8         19 my $json = $args->{json};
60 8 100       51 $dir_page = $args->{dir_page} if ( $args->{dir_page} );
61              
62             $app->hook(
63             before_dispatch => sub {
64 27     27   480708 my $c = shift;
65 27 100       257 return render_file( $c, $root, $handler ) if ( -f $root->to_string() );
66              
67 25 100       1325 if( $c->req->url->path =~ m"\Q/..\E(/|\z)"n ) {
68 2         263 $c->reply->not_found;
69 2         43359 return;
70             }
71              
72 23         2678 my $path = $root->rel_file( Mojo::Util::url_unescape( $c->req->url->path ) );
73 23 100       3947 if ( -f $path ) {
    100          
74 11         313 render_file( $c, $path, $handler );
75             }
76             elsif ( -d $path ) {
77 11 100 66     470 if ( $index && ( my $index_path = locate_index( $index, $path ) ) ) {
78 1         45 return render_file( $c, $index_path, $handler );
79             }
80              
81 10 100 100     71 if ( $c->req->url->path ne '/' && ! $c->req->url->path->trailing_slash ) {
82 1         194 $c->redirect_to($c->req->url->path->trailing_slash(1));
83 1         1233 return;
84             }
85              
86 9 100       853 if( $auto_index ) {
87 8         95 render_indexes( $c, $path, $json );
88             } else {
89 1         31 $c->reply->not_found;
90             }
91             }
92             },
93 8         164 );
94 8         303 return $app;
95             }
96              
97             sub locate_index {
98 1   50 1 0 18 my $index = shift || return;
99 1   33     5 my $dir = shift || Cwd::getcwd;
100 1         14 my $root = Mojo::Home->new($dir);
101 1 50       36 $index = ( ref $index eq 'ARRAY' ) ? $index : ["$index"];
102 1         5 for (@$index) {
103 1         18 my $path = $root->rel_file($_);
104 1 50       42 return $path if ( -e $path );
105             }
106             }
107              
108 14     14 0 180 sub render_file ($c, $path, $handler) {
  14         40  
  14         27  
  14         29  
  14         28  
109 14 100       105 $handler->( $c, $path ) if ref $handler eq 'CODE';
110 14 100       5691 return if $c->tx->res->code;
111 4         101 $c->reply->file($path);
112             }
113              
114 8     8 0 50 sub render_indexes ($c, $dir, $json) {
  8         29  
  8         17  
  8         17  
  8         14  
115 8 100       93 my @files =
116             ( $c->req->url->path eq '/' )
117             ? ()
118             : ( { url => '../', name => 'Parent Directory', size => '', type => '', mtime => '' } );
119 8         643 my $children = list_files($dir);
120              
121 8         299 my $cur_path = Encode::decode_utf8( Mojo::Util::url_unescape( $c->req->url->path ) );
122 8         1240 for my $basename ( sort { $a cmp $b } @$children ) {
  205         335  
123 87         344 my $file = "$dir/$basename";
124 87         731 my $url = Mojo::Path->new($cur_path)->trailing_slash(0);
125 87         5611 push @{ $url->parts }, $basename;
  87         249  
126              
127 87         2408 my $is_dir = -d $file;
128 87         270 my @stat = stat _;
129 87 100       257 if ($is_dir) {
130 11         36 $basename .= '/';
131 11         73 $url->trailing_slash(1);
132             }
133              
134 87 100 100     353 my $mime_type =
135             $is_dir
136             ? 'directory'
137             : ( $types->type( get_ext($file) || 'txt' ) || 'text/plain' );
138 87         1531 my $mtime = Mojo::Date->new( $stat[9] )->to_string();
139              
140 87   100     4016 push @files, {
141             url => $url,
142             name => $basename,
143             size => $stat[7] || 0,
144             type => $mime_type,
145             mtime => $mtime,
146             };
147             }
148              
149 8         86 my $any = { inline => $dir_page, files => \@files, cur_path => $cur_path };
150 8 100       31 if ($json) {
151 2         16 $c->respond_to(
152             json => { json => encode_json(\@files) },
153             any => $any,
154             );
155             }
156             else {
157 6         51 $c->render( %$any );
158             }
159             }
160              
161             sub get_ext {
162 76 100   76 0 625 $_[0] =~ /\.([0-9a-zA-Z]+)$/ || return;
163 70         462 return lc $1;
164             }
165              
166             sub list_files {
167 8   50 8 0 35 my $dir = shift || return [];
168 8         128 my $dh = DirHandle->new($dir);
169 8         769 my @children;
170 8         60 while ( defined( my $ent = $dh->read ) ) {
171 103 100 100     1626 next if $ent eq '.' or $ent eq '..';
172 87         416 push @children, Encode::decode_utf8($ent);
173             }
174 8         277 return [ @children ];
175             }
176              
177             1;
178              
179             __END__