File Coverage

blib/lib/Mojolicious/Plugin/Directory.pm
Criterion Covered Total %
statement 89 89 100.0
branch 29 32 90.6
condition 16 24 66.6
subroutine 15 15 100.0
pod 1 6 16.6
total 150 166 90.3


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::Directory;
2 8     8   17709 use strict;
  8         10  
  8         192  
3 8     8   24 use warnings;
  8         10  
  8         267  
4             our $VERSION = '0.12';
5              
6 8     8   28 use Cwd ();
  8         10  
  8         78  
7 8     8   585 use Encode ();
  8         7181  
  8         97  
8 8     8   3140 use DirHandle;
  8         3975  
  8         201  
9 8     8   468 use Mojo::Base qw{ Mojolicious::Plugin };
  8         5891  
  8         45  
10 8     8   2279 use Mojolicious::Types;
  8         526  
  8         764  
11 8     8   522 use Mojo::JSON qw(encode_json);
  8         42243  
  8         7145  
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 206 my $self = shift;
47 7         12 my ( $app, $args ) = @_;
48              
49 7   66     68 my $root = Mojo::Home->new( $args->{root} || Cwd::getcwd );
50 7         354 my $handler = $args->{handler};
51 7         10 my $index = $args->{dir_index};
52 7   100     32 my $auto_index = $args->{auto_index} // 1;
53 7         8 my $json = $args->{json};
54 7 100       23 $dir_page = $args->{dir_page} if ( $args->{dir_page} );
55              
56             $app->hook(
57             before_dispatch => sub {
58 20     20   128600 my $c = shift;
59 20 100       64 return render_file( $c, $root, $handler ) if ( -f $root->to_string() );
60 18         452 my $path = $root->rel_dir( Mojo::Util::url_unescape( $c->req->url->path ) );
61 18 100       1344 if ( -f $path ) {
    50          
62 9         20 render_file( $c, $path, $handler );
63             }
64             elsif ( -d $path ) {
65 9 100 66     37 if ( $index && ( my $index_path = locate_index( $index, $path ) ) ) {
66 1         1 return render_file( $c, $index_path, $handler );
67             }
68              
69 8 100       29 render_indexes( $c, $path, $json ) unless not $auto_index;
70             }
71             },
72 7         56 );
73 7         117 return $app;
74             }
75              
76             sub locate_index {
77 1   50 1 0 2 my $index = shift || return;
78 1   33     3 my $dir = shift || Cwd::getcwd;
79 1         4 my $root = Mojo::Home->new($dir);
80 1 50       21 $index = ( ref $index eq 'ARRAY' ) ? $index : ["$index"];
81 1         2 for (@$index) {
82 1         3 my $path = $root->rel_file($_);
83 1 50       27 return $path if ( -e $path );
84             }
85             }
86              
87             sub render_file {
88 12     12 0 62 my $c = shift;
89 12         13 my $path = shift;
90 12         10 my $handler = shift;
91 12 100       42 $handler->( $c, $path ) if ( ref $handler eq 'CODE' );
92 12 100       1803 return if ( $c->tx->res->code );
93 3         30 my $data = Mojo::Util::slurp($path);
94 3   50     199 $c->render( data => $data, format => get_ext($path) || 'txt' );
95             }
96              
97             sub render_indexes {
98 7     7 0 10 my $c = shift;
99 7         6 my $dir = shift;
100 7         9 my $json = shift;
101              
102 7 100       19 my @files =
103             ( $c->req->url->path eq '/' )
104             ? ()
105             : ( { url => '../', name => 'Parent Directory', size => '', type => '', mtime => '' } );
106 7         233 my $children = list_files($dir);
107              
108 7         209 my $cur_path = Encode::decode_utf8( Mojo::Util::url_unescape( $c->req->url->path ) );
109 7         436 for my $basename ( sort { $a cmp $b } @$children ) {
  160         180  
110 69         111 my $file = "$dir/$basename";
111 69         140 my $url = Mojo::Path->new($cur_path)->trailing_slash(0);
112 69         2595 push @{ $url->parts }, $basename;
  69         114  
113              
114 69         1009 my $is_dir = -d $file;
115 69         157 my @stat = stat _;
116 69 100       131 if ($is_dir) {
117 10         21 $basename .= '/';
118 10         20 $url->trailing_slash(1);
119             }
120              
121 69 100 100     167 my $mime_type =
122             $is_dir
123             ? 'directory'
124             : ( $types->type( get_ext($file) || 'txt' ) || 'text/plain' );
125 69         817 my $mtime = Mojo::Date->new( $stat[9] )->to_string();
126              
127 69   50     1954 push @files, {
128             url => $url,
129             name => $basename,
130             size => $stat[7] || 0,
131             type => $mime_type,
132             mtime => $mtime,
133             };
134             }
135              
136 7         31 my $any = { inline => $dir_page, files => \@files, cur_path => $cur_path };
137 7 100       16 if ($json) {
138 2         11 $c->respond_to(
139             json => { json => encode_json(\@files) },
140             any => $any,
141             );
142             }
143             else {
144 5         28 $c->render( %$any );
145             }
146             }
147              
148             sub get_ext {
149 62 100   62 0 289 $_[0] =~ /\.([0-9a-zA-Z]+)$/ || return;
150 56         292 return lc $1;
151             }
152              
153             sub list_files {
154 7   50 7 0 26 my $dir = shift || return [];
155 7         30 my $dh = DirHandle->new($dir);
156 7         319 my @children;
157 7         20 while ( defined( my $ent = $dh->read ) ) {
158 83 100 100     1225 next if $ent eq '.' or $ent eq '..';
159 69         106 push @children, Encode::decode_utf8($ent);
160             }
161 7         81 return [ @children ];
162             }
163              
164             1;
165              
166             __END__