File Coverage

blib/lib/Plack/App/SourceViewer.pm
Criterion Covered Total %
statement 69 70 98.5
branch 11 12 91.6
condition 5 9 55.5
subroutine 14 14 100.0
pod 2 2 100.0
total 101 107 94.3


line stmt bran cond sub pod time code
1             package Plack::App::SourceViewer;
2 2     2   58365 use strict;
  2         3  
  2         44  
3 2     2   6 use warnings;
  2         2  
  2         39  
4 2     2   372 use parent qw/Plack::Component/;
  2         244  
  2         8  
5 2     2   10654 use Plack::App::File;
  2         10990  
  2         43  
6 2     2   10 use Plack::Util;
  2         2  
  2         52  
7 2     2   1105 use Syntax::Highlight::Engine::Kate;
  2         22703  
  2         52  
8 2         10 use Plack::Util::Accessor qw/
9             root
10             encoding
11             content_type
12             ext_lang_map
13             css
14 2     2   10 /;
  2         2  
15              
16             our $VERSION = '0.02';
17              
18             my %EXT_LANG_MAP = (
19             '.pm' => 'Perl',
20             '.pl' => 'Perl',
21             '.psgi' => 'Perl',
22             '.t' => 'Perl',
23             );
24              
25             our $DEFAULT_CSS = <<'_CSS_';
26             body { font-size: 80%; font-family: "Consolas","Bitstream Vera Sans Mono","Courier New",Courier,monospace; }
27             table { margin: 12px 0 32px 0; border-collapse: collapse; }
28             td { white-space: nowrap; }
29             .line-count { text-align: right; padding-right: 8px; }
30             .alert { color: #0000ff; }
31             .basen { color: #007f00; }
32             .bstring { color: #c9a7ff; }
33             .char { color: #ff00ff; }
34             .comment { color: #7f7f7f; font-style: italic; }
35             .datatype { color: #0000ff; }
36             .decval { color: #00007f; }
37             .error { color: #ff0000; font-weight: bold; font-style: italic; }
38             .float { color: #00007f; }
39             .function { color: #007f00; }
40             .istring { color: #ff0000; }
41             .keyword { font-weight: bold; }
42             //.normal { color: #0000ff; }
43             .operator { color: #eea000; }
44             .others { color: #b03060; }
45             .regionmaker { color: #96b9ff; font-style: italic; }
46             .reserved { color: #9b30ff; font-weight: bold; }
47             .string { color: #ff0000; }
48             .variable { color: #0000ff; font-weight: bold; }
49             .warning { color: #0000ff; font-weight: bold; font-style: italic; }
50             _CSS_
51              
52             our $SCRIPT = <<'_SCRIPT_';
53            
54            
91             _SCRIPT_
92              
93             sub prepare_app {
94 3     3 1 18612 my $self = shift;
95              
96             $self->ext_lang_map({
97             %EXT_LANG_MAP,
98 3 100       8 %{$self->ext_lang_map || +{}},
  3         12  
99             });
100              
101 3 100       48 if (!$self->css) {
102 1         6 $self->css($DEFAULT_CSS);
103             }
104              
105 3 50       16 if (!$self->root) {
    100          
106 0         0 $self->root(['.']);
107             }
108             elsif (ref $self->root ne 'ARRAY') {
109 1         16 $self->root([$self->root]);
110             }
111             }
112              
113             sub call {
114 3     3 1 34 my ($self, $env) = @_;
115              
116 3         3 my $res;
117              
118 3         3 for my $root (@{ $self->root }) {
  3         5  
119 3   66     23 $self->{file}{$root} ||= Plack::App::File->new({
120             root => $root,
121             encoding => $self->encoding,
122             content_type => $self->content_type,
123             });
124 3         57 $res = $self->{file}{$root}->call($env);
125 3 100 66     469 if ($res && $res->[0] == 200) {
126 2         8 $self->_filter_response($env, $res);
127 2         54 last;
128             }
129             }
130              
131 3         21 return $res;
132             }
133              
134             sub _filter_response {
135 2     2   3 my ($self, $env, $res) = @_;
136              
137 2         2 my $path = $env->{PATH_INFO};
138 2         10 my ($ext) = ($path =~ m!.+(\..+)$!);
139 2         3 my $length;
140             my $body;
141              
142 2     1   7 my $body_sub = sub { $body .= Plack::Util::encode_html($_[0]) };
  1         52  
143 2 100       5 if ( my $lang = $self->ext_lang_map->{$ext} ) {
144 1   33     10 $self->{highlighter}{$lang} ||= $self->_highlighter($lang);
145 1     1   6429 $body_sub = sub { chomp $_[0]; $body .= $self->{highlighter}{$lang}->highlightText($_[0]) };
  1         72  
  1         7  
146             }
147              
148 2         13 Plack::Util::foreach($res->[2], $body_sub);
149 2         15701 $body =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
150              
151 2         4 $res->[2] = [];
152 2         12 $length += $self->_body($res->[2], <<"_HTML_");
153            
154            
155 2         20 @{[Plack::Util::encode_html($path)]}
156            
157 2         23
158            
159            
160             \n|
161             _HTML_
162 2         3 my $line_count = 1;
163 2         8 for my $line ( split /\n/, $body ) {
164 7         20 $length += $self->_body(
165             $res->[2],
166             qq|
$line_count$line
167             );
168 7         14 $line_count++;
169             }
170 2         9 $length += $self->_body(
171             $res->[2],
172             "
$SCRIPT",
173             );
174              
175 2         6 my $h = Plack::Util::headers($res->[1]);
176 2         54 $h->set('Content-Type', 'text/html');
177 2         67 $h->set('Content-Length', $length);
178             }
179              
180             sub _body {
181 11     11   24 my ($self, $array, $html) = @_;
182              
183 11         6 push @{$array}, $html;
  11         11  
184 11         12 return length $html;
185             }
186              
187             sub _highlighter {
188 1     1   2 my ($self, $language) = @_;
189              
190 1         29 return Syntax::Highlight::Engine::Kate->new(
191             language => $language,
192             substitutions => {
193             "<" => "<",
194             ">" => ">",
195             "&" => "&",
196             " " => " ",
197             "\t" => "  ",
198             },
199             format_table => {
200             Alert => [ qq||, "" ],
201             BaseN => [ qq||, "" ],
202             BString => [ qq||, "" ],
203             Char => [ qq||, "" ],
204             Comment => [ qq||, "" ],
205             DataType => [ qq||, "" ],
206             DecVal => [ qq||, "" ],
207             Error => [ qq||, "" ],
208             Float => [ qq||, "" ],
209             Function => [ qq||, "" ],
210             IString => [ qq||, "" ],
211             Keyword => [ qq||, "" ],
212             Normal => [ "", "" ],
213             Operator => [ qq||, "" ],
214             Others => [ qq||, "" ],
215             RegionMarker => [ qq||, "" ],
216             Reserved => [ qq||, "" ],
217             String => [ qq||, ""],
218             Variable => [ qq||, "" ],
219             Warning => [ qq||, "" ],
220             },
221             );
222             }
223              
224             1;
225              
226             __END__