1 #!/usr/bin/perl |
1 # |
|
2 # VimOutliner (OTL) XHTML pretty printer for mod_perl2/apache2. |
|
3 # |
|
4 # Copyright (c) 2006, Mahlon E. Smith <mahlon@martini.nu> |
|
5 # All rights reserved. |
|
6 # Redistribution and use in source and binary forms, with or without |
|
7 # modification, are permitted provided that the following conditions are met: |
|
8 # |
|
9 # * Redistributions of source code must retain the above copyright |
|
10 # notice, this list of conditions and the following disclaimer. |
|
11 # * Redistributions in binary form must reproduce the above copyright |
|
12 # notice, this list of conditions and the following disclaimer in the |
|
13 # documentation and/or other materials provided with the distribution. |
|
14 # * Neither the name of Mahlon E. Smith nor the names of his |
|
15 # contributors may be used to endorse or promote products derived |
|
16 # from this software without specific prior written permission. |
|
17 # |
|
18 # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY |
|
19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|
20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
|
21 # DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY |
|
22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES |
|
23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; |
|
24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
|
25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
|
26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
|
27 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
28 # |
2 |
29 |
3 package Apache::OTL; |
30 package Apache::OTL; |
4 use strict; |
31 use strict; |
|
32 use warnings; |
5 use Apache2::Const qw/ DECLINED OK /; |
33 use Apache2::Const qw/ DECLINED OK /; |
6 use Time::HiRes qw/ gettimeofday /; |
34 use Apache2::Request; |
|
35 use Apache2::RequestRec; |
|
36 use Apache2::RequestUtil; |
|
37 use Apache2::RequestIO; |
|
38 use Apache2::Log; |
|
39 use Time::HiRes 'gettimeofday'; |
7 |
40 |
8 sub handler |
41 sub handler |
9 { |
42 { |
10 my $r = shift; |
43 my $VERSION = '0.5'; |
11 my $VERSION = '0.4'; |
44 my $ID = '$Id$'; |
12 my $t0 = Time::HiRes::gettimeofday; |
45 my $r = shift; |
|
46 my $t0 = Time::HiRes::gettimeofday; |
13 my ( |
47 my ( |
14 $file, # the absolute file path |
48 $file, # the absolute file path |
15 $title, # the file's title |
49 $title, # the file's title |
16 $uri, # the file uri |
50 $uri, # the file uri |
17 %re, # a hash of pre compiled regular expressions |
|
18 $data, # file contents |
51 $data, # file contents |
19 %opt, # options from the otl file |
|
20 @blocks, # todo groupings |
52 @blocks, # todo groupings |
21 $mtime, # last modification time of otl file |
53 $mtime, # last modification time of otl file |
22 %get, # get arguments (sorting, etc) |
54 $get, # get arguments (sorting, etc) |
|
55 %opt, # options from otl file |
23 ); |
56 ); |
24 |
57 |
25 return DECLINED unless $r->method() eq 'GET'; |
58 # sanity checks |
26 ($file, $uri) = ($r->filename, $r->uri); |
59 return DECLINED unless $r->method eq 'GET'; |
|
60 |
|
61 ( $file, $uri ) = ( $r->filename, $r->uri ); |
27 return DECLINED unless -e $file; |
62 return DECLINED unless -e $file; |
28 $mtime = localtime( (stat(_))[9] ); |
63 $mtime = localtime( (stat(_))[9] ); |
29 |
64 |
30 %get = $r->args; |
65 my $req = Apache2::Request->new($r); |
31 |
66 $get = $req->param || {}; |
32 %re = |
67 |
33 ( |
68 my %re = ( |
34 title => qr/(?:.+)?\/(.+).otl$/i, |
69 title => qr/(?:.+)?\/(.+).otl$/i, |
35 percent => qr/(\[.\]) (\d+)%/, |
70 percent => qr/(\[.\]) (\d+)%/, |
36 todo => qr/(\[_\]) /, |
71 todo => qr/(\[_\]) /, |
37 done => qr/(\[X\]) /, |
72 done => qr/(\[X\]) /, |
38 comment => qr/^(?:\t+)?:(.+)/, |
73 comment => qr/^(?:\t+)?:(.+)/, |
39 time => qr/(\d{2}:\d{2}:\d{2})/, |
74 time => qr/(\d{2}:\d{2}:\d{2})/, |
40 date => qr/(\d{2,4}-\d{2}-\d{2})/, |
75 date => qr/(\d{2,4}-\d{2}-\d{2})/, |
41 subitem => qr/^\t(?!\t)/, |
76 subitem => qr/^\t(?!\t)/, |
42 line_wo_tabs => qr/^(?:\t+)?(.+)/, |
77 remove_tabs => qr/^(?:\t+)?(.+)/, |
43 linetext => qr/^(?:\[.\] (?:\d+%)?)? (.+)/, |
78 linetext => qr/^(?:\[.\] (?:\d+%)?)? (.+)/, |
|
79 |
|
80 comma_sep => qr/(?:\s+)?\,(?:\s+)?/, |
|
81 hideline => qr/(?:\t+)?\#/, |
44 ); |
82 ); |
45 |
83 |
46 open OTL, "$file" |
84 # snag file |
47 || ( $r->log_error("Unable to read $file: $!") && return DECLINED ); |
85 open OTL, $file |
|
86 or ( $r->log_error("Unable to read $file: $!") && return DECLINED ); |
48 do { |
87 do { |
49 local $/ = undef; |
88 local $/ = undef; |
50 $data = <OTL>; # shlorp |
89 $data = <OTL>; # shlorp |
51 }; |
90 }; |
52 close OTL; |
91 close OTL; |
53 |
92 |
54 # just spit out the plain otl if requested. |
93 # just spit out the plain otl if requested. |
55 if ($get{show} eq 'source') { |
94 if ( $get->{'show'} && $get->{show} eq 'source' ) { |
56 $r->content_type('text/plain'); |
95 $r->content_type('text/plain'); |
57 $r->print( $data ); |
96 $r->print( $data ); |
58 return OK; |
97 return OK; |
59 } |
98 } |
60 |
99 |
76 unshift @blocks, $settings; |
115 unshift @blocks, $settings; |
77 } |
116 } |
78 } |
117 } |
79 |
118 |
80 # GET args override settings |
119 # GET args override settings |
81 $opt{$_} = $get{$_} foreach keys %get; |
120 $opt{$_} = $get->{$_} foreach keys %$get; |
82 |
121 |
83 # set title (fallback to file uri) |
122 # set title (fallback to file uri) |
84 $title = |
123 $title = |
85 $opt{title} |
124 $opt{title} |
86 ? $opt{title} |
125 ? $opt{title} |
87 : $1 if $uri =~ $re{title}; |
126 : $1 if $uri =~ $re{title}; |
88 |
127 |
89 $opt{style} ||= '/otl_style.css'; |
128 # start html output |
90 |
|
91 $r->content_type('text/html'); |
129 $r->content_type('text/html'); |
92 $r->print(<<EHTML); |
130 $r->print(<<EHTML); |
|
131 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> |
93 <html> |
132 <html> |
94 <!-- |
133 <!-- |
95 generated by otl_handler $VERSION |
134 generated by otl_handler $VERSION |
96 Mahlon E. Smith <mahlon\@spime.net> |
135 Mahlon E. Smith <mahlon\@martini.nu> |
97 |
136 http://www.martini.nu/ |
98 http://www.vimoutliner.org/ |
137 |
|
138 Get VimOutliner at: http://www.vimoutliner.org/ |
99 --> |
139 --> |
100 <head> |
140 <head> |
101 <title>$title</title> |
141 <title>$title</title> |
102 <link href="$opt{style}" rel="stylesheet" media="screen" type="text/css"> |
|
103 EHTML |
142 EHTML |
104 |
143 |
105 if ($opt{js}) { |
144 # optional styles |
106 $r->print( |
145 if ( $opt{style} ) { |
107 ' ' x 8, |
146 foreach ( split /$re{'comma_sep'}/, $opt{style} ) { |
108 "<script type=\"text/javascript\" language=\"JavaScript\" src=\"$opt{js}\"></script>\n", |
147 my $media = $_ =~ /print/ ? 'print' : 'screen'; |
109 ' ' x 4, "</head>\n", |
148 print qq{\t<link href="$_" rel="stylesheet" media="$media" type="text/css" />\n}; |
110 "<body onLoad=\"init_page()\">\n", |
149 } |
111 ); |
150 } |
|
151 |
|
152 # optional javascript |
|
153 if ( $opt{js} ) { |
|
154 $r->print( "\t<script type=\"text/javascript\" src=\"$_\"></script>\n" ) |
|
155 foreach split /$re{'comma_sep'}/, $opt{js}; |
|
156 $r->print( ' ' x 4, "</head>\n" ); |
|
157 $r->print( ' ' x 4, "<body>\n" ); |
112 } else { |
158 } else { |
113 $r->print(<<EHTML); |
159 $r->print(<<EHTML); |
114 </head> |
160 </head> |
115 <body> |
161 <body> |
116 EHTML |
162 EHTML |
117 } |
163 } |
118 |
164 |
|
165 # title, last modification times |
119 $r->print("<div class=\"header\">$opt{title}</div>\n") if $opt{title}; |
166 $r->print("<div class=\"header\">$opt{title}</div>\n") if $opt{title}; |
120 $r->print("<div class=\"last_mod\">Last modified: $mtime</div>\n") if $opt{last_mod}; |
167 $r->print("<div class=\"last_mod\">Last modified: $mtime</div>\n") if $opt{last_mod}; |
121 if ($opt{legend}) { |
168 if ($opt{legend}) { |
122 $r->print(<<EHTML); |
169 $r->print(<<EHTML); |
123 <div class="legend"> |
170 <div class="legend"> |
124 <span class="done"> </span> Item completed<br /> |
171 <span class="done">Item completed</span><br /> |
125 <span class="todo"> </span> Item is incomplete<br /> |
172 <span class="todo">Item is incomplete</span><br /> |
126 </div> |
173 </div> |
127 EHTML |
174 EHTML |
128 } |
175 } |
|
176 |
|
177 # sorter |
129 if ($opt{sort}) { |
178 if ($opt{sort}) { |
130 my %sorts = ( |
179 my %sorts = ( |
131 alpha => 'alphabetical', |
180 alpha => 'alphabetical', |
132 percent => 'percentages', |
181 percent => 'percentages', |
133 ); |
182 ); |
142 } |
191 } |
143 } |
192 } |
144 $r->print("</div>\n"); |
193 $r->print("</div>\n"); |
145 } |
194 } |
146 |
195 |
147 my $bc = 0; |
|
148 foreach my $block ( sort { sorter(\%opt, \%re) } @blocks ) { |
196 foreach my $block ( sort { sorter(\%opt, \%re) } @blocks ) { |
149 # separate outline items |
197 # separate outline items |
150 my @items = split /\n/, $block; |
198 my @lines = grep { $_ !~ /$re{'hideline'}/ } split /\n/, $block; |
151 $r->print("<div class=\"group\">\n") if $opt{divs}; |
199 my $data = []; |
152 my $lc = 0; |
200 |
153 |
201 # build structure and get item counts |
154 # get item counts |
202 my ( $subs, $comments, $subsubs ) = ( 0, 0, 0 ); |
155 my ($subs, $comments, $subsubs); |
203 foreach ( @lines ) { |
156 if ($opt{counts}) { |
204 if (/$re{comment}/) { |
157 foreach (@items) { |
205 $comments++; |
158 if (/$re{comment}/) { |
206 } |
159 $comments++; |
207 elsif (/$re{subitem}/) { |
160 } elsif (/$re{subitem}/) { |
208 $subs++; |
161 $subs++; |
209 } |
162 } |
210 |
163 } |
211 my $level = 0; |
164 $subsubs = (scalar @items - 1) - $subs - $comments;; |
212 $level = $1 =~ tr/\t/\t/ if /^(\t+)/; |
165 } |
213 $level++; |
166 |
214 |
167 # parse |
215 s#$re{remove_tabs}#$1# unless $opt{'debug'}; |
168 foreach (@items) { |
216 push @$data, [ $level, $_ ]; |
169 next if /^\#/; |
217 } |
170 my $level = tr/\t/\t/ || 0; |
218 $subsubs = ( scalar @lines - 1 ) - $subs - $comments; |
171 next unless /\w/; |
219 |
|
220 # begin parsing structure |
|
221 $r->print("<div class=\"outline\">\n"); |
|
222 $r->print("<ul>\n") unless $opt{'debug'}; |
|
223 my $i = 0; |
|
224 foreach ( @$data ) { |
|
225 my ( $level, $line ) = @$_; |
|
226 |
|
227 if ( $opt{'debug'} ) { |
|
228 my $in = " " x $level x 4; |
|
229 $r->print( "$level:$in $line<br />\n" ); |
|
230 next; |
|
231 } |
|
232 |
|
233 my $next_level = $data->[ $i+1 ] ? $data->[ $i+1 ]->[0] : 0; |
|
234 my $in = "\t" x $level; |
|
235 |
|
236 $line =~ s#$re{'time'}#<span class="time">$1</span>#g; |
|
237 $line =~ s#$re{date}#<span class="date">$1</span>#g; |
|
238 $line =~ s#$re{percent}#$1 <span class="percent">$2%</span>#; |
172 |
239 |
173 # append counts |
240 # append counts |
174 if ($lc == 0 && $opt{counts} && $_ !~ $re{comment}) { |
241 if ( $i == 0 && $opt{counts} && $line !~ $re{comment} ) { |
175 my $itmstr = $subs == 1 ? 'item' : 'items'; |
242 my $itmstr = $subs == 1 ? 'item' : 'items'; |
176 my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems'; |
243 my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems'; |
177 $_ .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>"; |
244 $line .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>"; |
178 } |
245 } |
179 s/^:// if ! $level; |
246 |
180 |
247 my $li_class = '>'; |
181 if ($opt{js}) { |
248 $li_class = ' class="todo">' if $line =~ s#$re{todo}##; |
182 s#(.+)#<span id=\"itemtoplevel_$bc\">$1</span># if $lc == 0; |
249 $li_class = ' class="done">' if $line =~ s#$re{done}##; |
183 $r->print("<span id=\"itemgroup_$bc\">\n") if $lc == 1; |
250 $li_class = ' class="comment">' if $line =~ s#$re{comment}#$1#; |
184 } |
251 |
185 |
252 if ( $next_level == $level || $next_level == 0 ) { |
186 s#$re{'time'}#<span class="time">$1</span>#g if /$re{'time'}/; |
253 $r->print( "$in<li" . $li_class . "$line</li>\n" ); |
187 s#$re{date}#<span class="date">$1</span>#g if /$re{date}/; |
254 } |
188 s#$re{percent}#$1 <span class="percent">$2%</span># if /$re{percent}/; |
255 |
189 s#$re{todo}#<span class="todo"> </span># if /$re{todo}/; |
256 elsif ( $next_level < $level ) { |
190 s#$re{done}#<span class="done"> </span># if /$re{done}/; |
257 $r->print( "$in<li" . $li_class . "$line</li>\n" ); |
191 s#$re{comment}#<span class="comment">$1</span># if /$re{comment}/; |
258 for (my $x = $level - 1; $x >= $next_level; $x--) { |
192 s#$re{line_wo_tabs}#<span class="level$level">$1</span>#; |
259 my $in = "\t" x $x; |
193 |
260 $r->print( "$in</ul>\n$in</li>\n" ); |
194 $r->print("$_\n"); |
261 } |
195 $lc++; |
262 } |
196 } |
263 |
197 $r->print("</span>\n") if $opt{js}; |
264 else { |
198 $r->print("</div>\n") if $opt{divs}; |
265 # implicit: $next_level > $level AND $next_level != 0 |
199 $r->print("<br /><hr /><br />\n") if $opt{dividers}; |
266 $r->print("$in<li" . $li_class . "$line\n$in<ul>\n"); |
200 $r->print("<br /><br />\n") unless $opt{divs} || $opt{dividers}; |
267 } |
201 $bc++; |
268 |
|
269 $i++; |
|
270 } |
|
271 |
|
272 unless ( $opt{'debug'} ) { |
|
273 for (my $x = $data->[ scalar @$data - 1]->[0] - 1; $x > 0; $x--) { |
|
274 my $in = "\t" x $x; |
|
275 $r->print( "$in</ul>\n$in</li>\n" ); |
|
276 } |
|
277 $r->print( "</ul>\n" ); |
|
278 } |
|
279 $r->print( "</div>\n\n" ); |
202 } |
280 } |
203 |
281 |
204 my $t1 = Time::HiRes::gettimeofday; |
282 my $t1 = Time::HiRes::gettimeofday; |
205 my $td = sprintf("%0.3f", $t1 - $t0); |
283 my $td = sprintf("%0.3f", $t1 - $t0); |
206 $r->print("<div class=\"timer\">OTL parsed in $td secs</div>") if $opt{timer}; |
284 $r->print(" <div class=\"timer\">OTL parsed in $td secs</div>\n") if $opt{timer}; |
207 $r->print(<<EHTML); |
285 $r->print(<<EHTML); |
208 </body> |
286 </body> |
209 </html> |
287 </html> |
210 EHTML |
288 EHTML |
211 |
289 |