File Coverage

blib/lib/Plack/App/Directory.pm
Criterion Covered Total %
statement 57 63 90.4
branch 7 10 70.0
condition 7 8 87.5
subroutine 11 12 91.6
pod 0 3 0.0
total 82 96 85.4


";
line stmt bran cond sub pod time code
1             package Plack::App::Directory;
2 1     1   422 use parent qw(Plack::App::File);
  1         1  
  1         4  
3 1     1   75 use strict;
  1         3  
  1         25  
4 1     1   3 use warnings;
  1         2  
  1         31  
5 1     1   3 use Plack::Util;
  1         2  
  1         12  
6 1     1   3 use HTTP::Date;
  1         1  
  1         107  
7 1     1   5 use Plack::MIME;
  1         1  
  1         14  
8 1     1   687 use DirHandle;
  1         703  
  1         37  
9 1     1   8 use URI::Escape;
  1         2  
  1         144  
10 1     1   608 use Plack::Request;
  1         5  
  1         855  
11              
12             # Stolen from rack/directory.rb
13             my $dir_file = "
%s%s%s%s
14             my $dir_page = <
15            
16             %s
17            
18            
25            
26            

%s
27            
28            
29            
30             Name
31             Size
32             Type
33             Last Modified
34            
35             %s
36            
37            
38            
39             PAGE
40              
41             sub should_handle {
42 3     3 0 5 my($self, $file) = @_;
43 3   66     70 return -d $file || -f $file;
44             }
45              
46             sub return_dir_redirect {
47 0     0 0 0 my ($self, $env) = @_;
48 0         0 my $uri = Plack::Request->new($env)->uri;
49 0         0 return [ 301,
50             [
51             'Location' => $uri . '/',
52             'Content-Type' => 'text/plain',
53             'Content-Length' => 8,
54             ],
55             [ 'Redirect' ],
56             ];
57             }
58              
59             sub serve_path {
60 3     3 0 33 my($self, $env, $dir) = @_;
61              
62 3 100       22 if (-f $dir) {
63 1         8 return $self->SUPER::serve_path($env, $dir);
64             }
65              
66 2         5 my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
67              
68 2 50       7 if ($dir_url !~ m{/$}) {
69 0         0 return $self->return_dir_redirect($env);
70             }
71              
72 2         7 my @files = ([ "../", "Parent Directory", '', '', '' ]);
73              
74 2         9 my $dh = DirHandle->new($dir);
75 2         130 my @children;
76 2         5 while (defined(my $ent = $dh->read)) {
77 10 100 100     101 next if $ent eq '.' or $ent eq '..';
78 6         9 push @children, $ent;
79             }
80              
81 2         22 for my $basename (sort { $a cmp $b } @children) {
  4         9  
82 6         56 my $file = "$dir/$basename";
83 6         7 my $url = $dir_url . $basename;
84              
85 6         74 my $is_dir = -d $file;
86 6         18 my @stat = stat _;
87              
88 6         91 $url = join '/', map {uri_escape($_)} split m{/}, $url;
  12         108  
89              
90 6 50       82 if ($is_dir) {
91 0         0 $basename .= "/";
92 0         0 $url .= "/";
93             }
94              
95 6 50 100     39 my $mime_type = $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' );
96 6         14 push @files, [ $url, $basename, $stat[7], $mime_type, HTTP::Date::time2str($stat[9]) ];
97             }
98              
99 2         24 my $path = Plack::Util::encode_html("Index of $env->{PATH_INFO}");
100             my $files = join "\n", map {
101 2         4 my $f = $_;
  8         7  
102 8         13 sprintf $dir_file, map Plack::Util::encode_html($_), @$f;
103             } @files;
104 2         12 my $page = sprintf $dir_page, $path, $path, $files;
105              
106 2         25 return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
107             }
108              
109             1;
110              
111             __END__