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__ |