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   542 use parent qw(Plack::App::File);
  1         2  
  1         5  
3 1     1   43 use strict;
  1         2  
  1         18  
4 1     1   6 use warnings;
  1         1  
  1         21  
5 1     1   5 use Plack::Util;
  1         2  
  1         17  
6 1     1   4 use HTTP::Date;
  1         2  
  1         42  
7 1     1   5 use Plack::MIME;
  1         2  
  1         17  
8 1     1   545 use DirHandle;
  1         497  
  1         30  
9 1     1   7 use URI::Escape;
  1         2  
  1         49  
10 1     1   447 use Plack::Request;
  1         3  
  1         581  
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 8 my($self, $file) = @_;
43 3   66     86 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 10 my($self, $env, $dir) = @_;
61              
62 3 100       38 if (-f $dir) {
63 1         14 return $self->SUPER::serve_path($env, $dir);
64             }
65              
66 2         10 my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
67              
68 2 50       12 if ($dir_url !~ m{/$}) {
69 0         0 return $self->return_dir_redirect($env);
70             }
71              
72 2         9 my @files = ([ "../", "Parent Directory", '', '', '' ]);
73              
74 2         14 my $dh = DirHandle->new($dir);
75 2         144 my @children;
76 2         8 while (defined(my $ent = $dh->read)) {
77 10 100 100     174 next if $ent eq '.' or $ent eq '..';
78 6         24 push @children, $ent;
79             }
80              
81 2         34 for my $basename (sort { $a cmp $b } @children) {
  6         17  
82 6         88 my $file = "$dir/$basename";
83 6         20 my $url = $dir_url . $basename;
84              
85 6         88 my $is_dir = -d $file;
86 6         32 my @stat = stat _;
87              
88 6         23 $url = join '/', map {uri_escape($_)} split m{/}, $url;
  12         140  
89              
90 6 50       96 if ($is_dir) {
91 0         0 $basename .= "/";
92 0         0 $url .= "/";
93             }
94              
95 6 50 100     32 my $mime_type = $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' );
96 6         22 push @files, [ $url, $basename, $stat[7], $mime_type, HTTP::Date::time2str($stat[9]) ];
97             }
98              
99 2         39 my $path = Plack::Util::encode_html("Index of $env->{PATH_INFO}");
100             my $files = join "\n", map {
101 2         6 my $f = $_;
  8         12  
102 8         18 sprintf $dir_file, map Plack::Util::encode_html($_), @$f;
103             } @files;
104 2         23 my $page = sprintf $dir_page, $path, $path, $files;
105              
106 2         17 return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
107             }
108              
109             1;
110              
111             __END__