File Coverage

blib/lib/Plack/App/Directory/Markdown.pm
Criterion Covered Total %
statement 93 119 78.1
branch 11 20 55.0
condition 8 23 34.7
subroutine 20 21 95.2
pod 2 7 28.5
total 134 190 70.5


line stmt bran cond sub pod time code
1             package Plack::App::Directory::Markdown;
2 2     2   63620 use strict;
  2         3  
  2         63  
3 2     2   8 use warnings;
  2         2  
  2         40  
4 2     2   1141 use utf8;
  2         21  
  2         8  
5             our $VERSION = '0.09';
6              
7 2     2   518 use parent 'Plack::App::Directory';
  2         242  
  2         11  
8 2     2   141026 use Encode qw/encode_utf8/;
  2         19838  
  2         188  
9 2     2   1101 use Data::Section::Simple;
  2         1181  
  2         99  
10 2     2   1178 use Text::Xslate;
  2         16602  
  2         109  
11 2     2   18 use HTTP::Date;
  2         3  
  2         102  
12 2     2   9 use URI::Escape qw/uri_escape/;
  2         2  
  2         90  
13 2     2   1186 use Plack::Middleware::Bootstrap;
  2         150465  
  2         70  
14 2     2   1010 use Plack::Builder;
  2         5201  
  2         160  
15              
16 2     2   12 use Plack::Util::Accessor;
  2         2  
  2         8  
17             Plack::Util::Accessor::mk_accessors(__PACKAGE__, qw(title tx tx_path markdown_class markdown_ext));
18              
19             sub new {
20 1     1 1 13 my $cls = shift;
21              
22 1         13 my $self = $cls->SUPER::new(@_);
23 1   33     22 $self->tx(
24             Text::Xslate->new(
25             path => [
26             ($self->tx_path || ()),
27             Data::Section::Simple->new->get_data_section,
28             ],
29             function => { process_path => \&process_path, }
30             )
31             );
32 1         731 $self;
33             }
34              
35             sub to_app {
36 5     5 1 49538 my $self = shift;
37              
38 5         27 my $app = $self->SUPER::to_app;
39              
40             builder {
41 5     5   196 enable 'Bootstrap';
42 5         199 $app;
43 5         73 };
44             }
45              
46             sub markdown {
47 1     1 0 2 my $self = shift;
48              
49 1   33     104 my $md = $self->{_md} ||= do {
50 1   50     5 my $cls = $self->markdown_class || 'Text::Markdown';
51 1         18 Plack::Util::load_class($cls);
52              
53 0         0 $cls->new;
54             };
55              
56 0         0 $md->markdown(@_);
57             }
58              
59             sub serve_path {
60 3     3 0 552 my($self, $env, $dir) = @_;
61              
62 3 100       29 if (-f $dir) {
63 1 50       4 if ($self->is_markdown($dir)) {
64 1 50   1   1 my $content = do {local $/;open my $fh,'<:encoding(UTF-8)',$dir or die $!;<$fh>};
  1         4  
  1         32  
  1         1308  
  1         7  
  1         2  
  1         7  
65 1         27 $content = $self->markdown($content);
66              
67 0         0 my $path = $self->remove_root_path($dir);
68 0         0 $path =~ s/\.(?:markdown|mk?dn?)$//;
69              
70 0   0     0 my $page = $self->tx->render('md.tx', {
71             path => $path,
72             title => ($self->title || 'Markdown'),
73             content => $content,
74             });
75 0         0 $page = encode_utf8($page);
76              
77 0         0 my @stat = stat $dir;
78 0         0 return [ 200, [
79             'Content-Type' => 'text/html; charset=utf-8',
80             'Last-Modified' => HTTP::Date::time2str( $stat[9] ),
81             ], [ $page ] ];
82             }
83             else {
84 0         0 return $self->SUPER::serve_path($env, $dir);
85             }
86             }
87              
88 2         7 my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
89              
90 2 50       16 if ($dir_url !~ m{/$}) {
91 0         0 return $self->return_dir_redirect($env);
92             }
93              
94 2         4 my @files;
95 2 50       10 push @files, ({ link => "../", name => "Parent Directory" }) if $env->{PATH_INFO} ne '/';
96              
97 2         17 my $dh = DirHandle->new($dir);
98 2         123 my @children;
99 2         10 while (defined(my $ent = $dh->read)) {
100 6 100 100     78 next if $ent eq '.' or $ent eq '..';
101 2         26 push @children, $ent;
102             }
103              
104 2         15 for my $basename (sort { $a cmp $b } @children) {
  0         0  
105 2         5 my $file = "$dir/$basename";
106 2         3 my $url = $dir_url . $basename;
107              
108 2         22 my $is_dir = -d $file;
109 2 50 33     12 next if !$is_dir && !$self->is_markdown($file);
110              
111 2         15 my @stat = stat _;
112              
113 2         8 $url = join '/', map {uri_escape($_)} split m{/}, $url;
  4         45  
114              
115 2 50       34 if ($is_dir) {
116 0         0 $basename .= "/";
117 0         0 $url .= "/";
118             }
119 2         44 push @files, { link => $url, name => $basename, mtime => HTTP::Date::time2str($stat[9]) };
120             }
121              
122 2         49 my $path = Plack::Util::encode_html( $env->{PATH_INFO} );
123 2         22 $path =~ s{^/}{};
124 2   50     10 my $page = $self->tx->render('index.tx', {
125             title => ($self->title || 'Markdown'),
126             files => \@files,
127             path => $path
128             });
129 2         22 $page = encode_utf8($page);
130 2         21 return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
131             }
132              
133             sub is_markdown {
134 3     3 0 5 my ($self, $file) = @_;
135 3 50       12 if ($self->markdown_ext) {
136 0         0 my $ext = quotemeta $self->markdown_ext;
137 0         0 $file =~ /$ext$/;
138             }
139             else {
140 3         39 $file =~ /\.(?:markdown|mk?dn?)$/;
141             }
142             }
143              
144             sub remove_root_path {
145 0     0 0 0 my ($self, $path) = @_;
146              
147 0         0 $path =~ s!^\./?!!;
148 0   0     0 my $root = $self->root || '';
149 0         0 $root =~ s!^\./?!!;
150 0 0 0     0 $root .= '/' if $root && $root !~ m!/$!;
151 0         0 $root = quotemeta $root;
152 0         0 $path =~ s!^$root!!;
153              
154 0         0 $path;
155             }
156              
157             sub process_path {
158 2     2 0 737 my $path = shift;
159              
160 2         4 my @out;
161 2         4 my $i = 0;
162 2         8 foreach my $part (reverse(split('/',$path))) {
163 0         0 my $link = '../' x $i;
164              
165 0         0 push @out,
166             {
167             name => $part,
168             link => "${link}",
169             };
170 0         0 $i++;
171             }
172 2         6 $out[0]->{link} = ''; # Last element should link to itself
173 2         21 return [ reverse @out ];
174             }
175              
176             1;
177              
178             __DATA__