File Coverage

blib/lib/Mojolicious/Plugin/Directory.pm
Criterion Covered Total %
statement 92 92 100.0
branch 31 34 91.1
condition 19 27 70.3
subroutine 15 15 100.0
pod 1 6 16.6
total 158 174 90.8


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::Directory;
2 8     8   17903 use strict;
  8         24  
  8         215  
3 8     8   39 use warnings;
  8         18  
  8         389  
4             our $VERSION = '0.14';
5              
6 8     8   44 use Cwd ();
  8         20  
  8         92  
7 8     8   479 use Encode ();
  8         7623  
  8         123  
8 8     8   2886 use DirHandle;
  8         4406  
  8         224  
9 8     8   408 use Mojo::Base qw{ Mojolicious::Plugin };
  8         5693  
  8         55  
10 8     8   3077 use Mojolicious::Types;
  8         562  
  8         65  
11 8     8   538 use Mojo::JSON qw(encode_json);
  8         78790  
  8         7279  
12              
13             # Stolen from Plack::App::Direcotry
14             my $dir_page = <<'PAGE';
15            
16             Index of <%= $cur_path %>
17            
18            
25            
26            

Index of <%= $cur_path %>
27            
28            
29            
30             Name
31             Size
32             Type
33             Last Modified
34            
35             % for my $file (@$files) {
36            
<%== $file->{name} %><%= $file->{size} %><%= $file->{type} %><%= $file->{mtime} %>
37             % }
38            
39            
40            
41             PAGE
42              
43             my $types = Mojolicious::Types->new;
44              
45             sub register {
46 7     7 1 250 my $self = shift;
47 7         14 my ( $app, $args ) = @_;
48              
49 7   66     86 my $root = Mojo::Home->new( $args->{root} || Cwd::getcwd );
50 7         74 my $handler = $args->{handler};
51 7         15 my $index = $args->{dir_index};
52 7   100     41 my $auto_index = $args->{auto_index} // 1;
53 7         17 my $json = $args->{json};
54 7 100       31 $dir_page = $args->{dir_page} if ( $args->{dir_page} );
55              
56             $app->hook(
57             before_dispatch => sub {
58 21     21   182541 my $c = shift;
59 21 100       116 return render_file( $c, $root, $handler ) if ( -f $root->to_string() );
60 19         677 my $path = $root->rel_file( Mojo::Util::url_unescape( $c->req->url->path ) );
61 19 100       1890 if ( -f $path ) {
    50          
62 9         119 render_file( $c, $path, $handler );
63             }
64             elsif ( -d $path ) {
65 10 100 66     298 if ( $index && ( my $index_path = locate_index( $index, $path ) ) ) {
66 1         25 return render_file( $c, $index_path, $handler );
67             }
68              
69 9 100 100     41 if ( $c->req->url->path ne '/' && ! $c->req->url->path->trailing_slash ) {
70 1         116 $c->redirect_to($c->req->url->path->trailing_slash(1));
71 1         610 return;
72             }
73              
74 8 100       531 render_indexes( $c, $path, $json ) unless not $auto_index;
75             }
76             },
77 7         71 );
78 7         181 return $app;
79             }
80              
81             sub locate_index {
82 1   50 1 0 4 my $index = shift || return;
83 1   33     3 my $dir = shift || Cwd::getcwd;
84 1         9 my $root = Mojo::Home->new($dir);
85 1 50       11 $index = ( ref $index eq 'ARRAY' ) ? $index : ["$index"];
86 1         4 for (@$index) {
87 1         3 my $path = $root->rel_file($_);
88 1 50       27 return $path if ( -e $path );
89             }
90             }
91              
92             sub render_file {
93 12     12 0 97 my $c = shift;
94 12         22 my $path = shift;
95 12         18 my $handler = shift;
96 12 100       59 $handler->( $c, $path ) if ( ref $handler eq 'CODE' );
97 12 100       2327 return if ( $c->tx->res->code );
98 3         42 my $data = Mojo::File::slurp($path);
99 3   50     270 $c->render( data => $data, format => get_ext($path) || 'txt' );
100             }
101              
102             sub render_indexes {
103 7     7 0 18 my $c = shift;
104 7         16 my $dir = shift;
105 7         14 my $json = shift;
106              
107 7 100       23 my @files =
108             ( $c->req->url->path eq '/' )
109             ? ()
110             : ( { url => '../', name => 'Parent Directory', size => '', type => '', mtime => '' } );
111 7         391 my $children = list_files($dir);
112              
113 7         249 my $cur_path = Encode::decode_utf8( Mojo::Util::url_unescape( $c->req->url->path ) );
114 7         723 for my $basename ( sort { $a cmp $b } @$children ) {
  160         260  
115 69         228 my $file = "$dir/$basename";
116 69         619 my $url = Mojo::Path->new($cur_path)->trailing_slash(0);
117 69         3901 push @{ $url->parts }, $basename;
  69         163  
118              
119 69         1236 my $is_dir = -d $file;
120 69         243 my @stat = stat _;
121 69 100       198 if ($is_dir) {
122 10         27 $basename .= '/';
123 10         32 $url->trailing_slash(1);
124             }
125              
126 69 100 100     268 my $mime_type =
127             $is_dir
128             ? 'directory'
129             : ( $types->type( get_ext($file) || 'txt' ) || 'text/plain' );
130 69         1007 my $mtime = Mojo::Date->new( $stat[9] )->to_string();
131              
132 69   50     2547 push @files, {
133             url => $url,
134             name => $basename,
135             size => $stat[7] || 0,
136             type => $mime_type,
137             mtime => $mtime,
138             };
139             }
140              
141 7         35 my $any = { inline => $dir_page, files => \@files, cur_path => $cur_path };
142 7 100       23 if ($json) {
143 2         13 $c->respond_to(
144             json => { json => encode_json(\@files) },
145             any => $any,
146             );
147             }
148             else {
149 5         32 $c->render( %$any );
150             }
151             }
152              
153             sub get_ext {
154 62 100   62 0 356 $_[0] =~ /\.([0-9a-zA-Z]+)$/ || return;
155 56         354 return lc $1;
156             }
157              
158             sub list_files {
159 7   50 7 0 28 my $dir = shift || return [];
160 7         79 my $dh = DirHandle->new($dir);
161 7         463 my @children;
162 7         28 while ( defined( my $ent = $dh->read ) ) {
163 83 100 100     1836 next if $ent eq '.' or $ent eq '..';
164 69         165 push @children, Encode::decode_utf8($ent);
165             }
166 7         99 return [ @children ];
167             }
168              
169             1;
170              
171             __END__