File Coverage

blib/lib/Plack/App/Directory/Markdown.pm
Criterion Covered Total %
statement 138 145 95.1
branch 19 28 67.8
condition 15 31 48.3
subroutine 24 24 100.0
pod 2 7 28.5
total 198 235 84.2


line stmt bran cond sub pod time code
1             package Plack::App::Directory::Markdown;
2 3     3   104921 use strict;
  3         4  
  3         89  
3 3     3   14 use warnings;
  3         3  
  3         84  
4 3     3   1790 use utf8;
  3         34  
  3         11  
5             our $VERSION = '0.11';
6              
7 3     3   717 use parent 'Plack::App::Directory';
  3         380  
  3         14  
8 3     3   211796 use Encode qw/encode_utf8/;
  3         5  
  3         114  
9 3     3   1318 use Data::Section::Simple;
  3         1321  
  3         111  
10 3     3   1315 use Text::Xslate;
  3         21037  
  3         140  
11 3     3   23 use HTTP::Date;
  3         4  
  3         145  
12 3     3   10 use URI::Escape qw/uri_escape/;
  3         5  
  3         129  
13 3     3   1752 use Path::Iterator::Rule;
  3         31694  
  3         97  
14 3     3   1480 use Plack::Middleware::Bootstrap;
  3         169929  
  3         134  
15 3     3   1798 use Plack::Builder;
  3         9432  
  3         309  
16              
17 3     3   23 use Plack::Util::Accessor;
  3         8  
  3         12  
18             Plack::Util::Accessor::mk_accessors(__PACKAGE__, qw(
19             title
20             tx
21             tx_path
22             markdown_class
23             markdown_ext
24             callback
25             ));
26              
27             sub new {
28 2     2 1 37 my $cls = shift;
29              
30 2         28 my $self = $cls->SUPER::new(@_);
31 2   33     37 $self->tx(
32             Text::Xslate->new(
33             path => [
34             ($self->tx_path || ()),
35             Data::Section::Simple->new->get_data_section,
36             ],
37             function => { process_path => \&process_path, }
38             )
39             );
40 2         1358 $self;
41             }
42              
43             sub to_app {
44 6     6 1 53239 my $self = shift;
45              
46 6         41 my $app = $self->SUPER::to_app;
47              
48             builder {
49 6     6   179 enable 'Bootstrap';
50 6         205 $app;
51 6         74 };
52             }
53              
54             sub markdown {
55 2     2 0 4 my $self = shift;
56              
57 2   33     99 my $md = $self->{_md} ||= do {
58 2   50     8 my $cls = $self->markdown_class || 'Text::Markdown';
59 2         23 Plack::Util::load_class($cls);
60              
61 2         29516 $cls->new;
62             };
63              
64 2         70 $md->markdown(@_);
65             }
66              
67             sub _md_files {
68 2     2   10 my $self = shift;
69 2   33     14 $self->{_md_files} ||= do {
70 2         3 my @files;
71 2         23 my $rule = Path::Iterator::Rule->new;
72 2   50     21 my $iter = $rule->iter($self->root // '.', {
73             depthfirst => 1,
74             });
75 2         250 while ( defined ( my $file = $iter->() ) ) {
76 8 100 66     788 push @files, $self->remove_root_path($file)
77             if -f -r $file && $self->is_markdown($file);
78             }
79 2         76 \@files;
80             };
81             }
82              
83             sub _search_prev_and_next {
84 2     2   3 my ($self, $file) = @_;
85 2         5 my ($prev, $next);
86              
87 2         4 my @md_files = @{ $self->_md_files };
  2         7  
88 2         3 my $found;
89 2         7 while (defined (my $f = shift @md_files) ) {
90 4 100       10 if ($file eq $f) {
91 2         3 $found = 1;
92 2         4 $next = shift @md_files;
93 2         4 last;
94             }
95 2         6 $prev = $f;
96             }
97 2 50       9 $found ? ($prev, $next) : ();
98             }
99              
100             sub serve_path {
101 4     4 0 724 my($self, $env, $dir) = @_;
102              
103 4 100       32 if (-f $dir) {
104 2 50       10 if ($self->is_markdown($dir)) {
105 2 50   2   4 my $content = do {local $/;open my $fh,'<:encoding(UTF-8)',$dir or die $!;<$fh>};
  2         14  
  2         83  
  2         2019  
  2         12  
  2         2  
  2         10  
106 2         55 $content = $self->markdown($content);
107              
108 2 100       3632 if ($self->callback) {
109 1         11 $self->callback->(\$content, $env, $dir);
110             }
111              
112 2         31 my $path = $self->remove_root_path($dir);
113 2         12 $path =~ s/\.(?:markdown|mk?dn?)$//;
114              
115 2         7 my ($prev, $next) = $self->_search_prev_and_next($self->remove_root_path($dir));
116 2   50     11 my $page = $self->tx->render('md.tx', {
117             path => $path,
118             title => ($self->title || 'Markdown'),
119             content => $content,
120             prev => $prev,
121             next => $next,
122             });
123 2         5635 $page = encode_utf8($page);
124              
125 2         41 my @stat = stat $dir;
126 2         17 return [ 200, [
127             'Content-Type' => 'text/html; charset=utf-8',
128             'Last-Modified' => HTTP::Date::time2str( $stat[9] ),
129             ], [ $page ] ];
130             }
131             else {
132 0         0 return $self->SUPER::serve_path($env, $dir);
133             }
134             }
135              
136 2         6 my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
137              
138 2 50       11 if ($dir_url !~ m{/$}) {
139 0         0 return $self->return_dir_redirect($env);
140             }
141              
142 2         2 my @files;
143 2 50       6 push @files, ({ link => "../", name => "Parent Directory" }) if $env->{PATH_INFO} ne '/';
144              
145 2         14 my $dh = DirHandle->new($dir);
146 2         130 my @children;
147 2         29 while (defined(my $ent = $dh->read)) {
148 6 100 100     72 next if $ent eq '.' or $ent eq '..';
149 2         6 push @children, $ent;
150             }
151              
152 2         18 for my $basename (sort { $a cmp $b } @children) {
  0         0  
153 2         5 my $file = "$dir/$basename";
154 2         5 my $url = $dir_url . $basename;
155              
156 2         20 my $is_dir = -d $file;
157 2 50 33     10 next if !$is_dir && !$self->is_markdown($file);
158              
159 2         12 my @stat = stat _;
160              
161 2         6 $url = join '/', map {uri_escape($_)} split m{/}, $url;
  4         46  
162              
163 2 50       39 if ($is_dir) {
164 0         0 $basename .= "/";
165 0         0 $url .= "/";
166             }
167 2         10 push @files, { link => $url, name => $basename, mtime => HTTP::Date::time2str($stat[9]) };
168             }
169              
170 2         46 my $path = Plack::Util::encode_html( $env->{PATH_INFO} );
171 2         20 $path =~ s{^/}{};
172 2   50     9 my $page = $self->tx->render('index.tx', {
173             title => ($self->title || 'Markdown'),
174             files => \@files,
175             path => $path
176             });
177 2         22 $page = encode_utf8($page);
178 2         27 return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
179             }
180              
181             sub is_markdown {
182 8     8 0 12 my ($self, $file) = @_;
183 8 50       28 if ($self->markdown_ext) {
184 0         0 my $ext = quotemeta $self->markdown_ext;
185 0         0 $file =~ /$ext$/;
186             }
187             else {
188 8         104 $file =~ /\.(?:markdown|mk?dn?)$/;
189             }
190             }
191              
192             sub remove_root_path {
193 8     8 0 11 my ($self, $path) = @_;
194              
195 8         12 $path =~ s!^\./?!!;
196 8   50     19 my $root = $self->root || '';
197 8         34 $root =~ s!^\./?!!;
198 8 50 33     41 $root .= '/' if $root && $root !~ m!/$!;
199 8         10 $root = quotemeta $root;
200 8         36 $path =~ s!^$root!!;
201              
202 8         25 $path;
203             }
204              
205             sub process_path {
206 4     4 0 79367 my $path = shift;
207              
208 4         7 my @out;
209 4         8 my $i = 0;
210 4         18 foreach my $part (reverse(split('/',$path))) {
211 4         8 my $link = '../' x $i;
212              
213 4         12 push @out,
214             {
215             name => $part,
216             link => "${link}",
217             };
218 4         5 $i++;
219             }
220 4         10 $out[0]->{link} = ''; # Last element should link to itself
221 4         49 return [ reverse @out ];
222             }
223              
224             1;
225              
226             __DATA__