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