|
1 #!/usr/bin/perl |
|
2 |
|
3 package Apache::OTL; |
|
4 use strict; |
|
5 use Apache2::Const qw/ DECLINED OK /; |
|
6 use Time::HiRes qw/ gettimeofday /; |
|
7 |
|
8 sub handler |
|
9 { |
|
10 my $r = shift; |
|
11 my $VERSION = '0.4'; |
|
12 my $t0 = Time::HiRes::gettimeofday; |
|
13 my ( |
|
14 $file, # the absolute file path |
|
15 $title, # the file's title |
|
16 $uri, # the file uri |
|
17 %re, # a hash of pre compiled regular expressions |
|
18 $data, # file contents |
|
19 %opt, # options from the otl file |
|
20 @blocks, # todo groupings |
|
21 $mtime, # last modification time of otl file |
|
22 %get, # get arguments (sorting, etc) |
|
23 ); |
|
24 |
|
25 return DECLINED unless $r->method() eq 'GET'; |
|
26 ($file, $uri) = ($r->filename, $r->uri); |
|
27 return DECLINED unless -e $file; |
|
28 $mtime = localtime( (stat(_))[9] ); |
|
29 |
|
30 %get = $r->args; |
|
31 |
|
32 %re = |
|
33 ( |
|
34 title => qr/(?:.+)?\/(.+).otl$/i, |
|
35 percent => qr/(\[.\]) (\d+)%/, |
|
36 todo => qr/(\[_\]) /, |
|
37 done => qr/(\[X\]) /, |
|
38 comment => qr/^(?:\t+)?:(.+)/, |
|
39 time => qr/(\d{2}:\d{2}:\d{2})/, |
|
40 date => qr/(\d{2,4}-\d{2}-\d{2})/, |
|
41 subitem => qr/^\t(?!\t)/, |
|
42 line_wo_tabs => qr/^(?:\t+)?(.+)/, |
|
43 linetext => qr/^(?:\[.\] (?:\d+%)?)? (.+)/, |
|
44 ); |
|
45 |
|
46 open OTL, "$file" |
|
47 || ( $r->log_error("Unable to read $file: $!") && return DECLINED ); |
|
48 do { |
|
49 local $/ = undef; |
|
50 $data = <OTL>; # shlorp |
|
51 }; |
|
52 close OTL; |
|
53 |
|
54 # just spit out the plain otl if requested. |
|
55 if ($get{show} eq 'source') { |
|
56 $r->content_type('text/plain'); |
|
57 $r->print( $data ); |
|
58 return OK; |
|
59 } |
|
60 |
|
61 # divide each outline into groups |
|
62 # skip blocks that start with a comment '#' |
|
63 @blocks = grep { $_ !~ /^\#/ } split /\n\n+/, $data; |
|
64 |
|
65 # get optional settings and otl title |
|
66 { |
|
67 my $settings = shift @blocks; |
|
68 if ($settings =~ $re{comment}) { |
|
69 %opt = map { split /=/ } split /\s?:/, $settings; |
|
70 } |
|
71 |
|
72 # if the first group wasn't a comment, |
|
73 # we probably just aren't using a settings |
|
74 # line. push the group back into place. |
|
75 else { |
|
76 unshift @blocks, $settings; |
|
77 } |
|
78 } |
|
79 |
|
80 # GET args override settings |
|
81 $opt{$_} = $get{$_} foreach keys %get; |
|
82 |
|
83 # set title (fallback to file uri) |
|
84 $title = |
|
85 $opt{title} |
|
86 ? $opt{title} |
|
87 : $1 if $uri =~ $re{title}; |
|
88 |
|
89 $opt{style} ||= '/otl_style.css'; |
|
90 |
|
91 $r->content_type('text/html'); |
|
92 $r->print(<<EHTML); |
|
93 <html> |
|
94 <!-- |
|
95 generated by otl_handler $VERSION |
|
96 Mahlon E. Smith <mahlon\@spime.net> |
|
97 |
|
98 http://www.vimoutliner.org/ |
|
99 --> |
|
100 <head> |
|
101 <title>$title</title> |
|
102 <link href="$opt{style}" rel="stylesheet" media="screen" type="text/css"> |
|
103 EHTML |
|
104 |
|
105 if ($opt{js}) { |
|
106 $r->print( |
|
107 ' ' x 8, |
|
108 "<script type=\"text/javascript\" language=\"JavaScript\" src=\"$opt{js}\"></script>\n", |
|
109 ' ' x 4, "</head>\n", |
|
110 "<body onLoad=\"init_page()\">\n", |
|
111 ); |
|
112 } else { |
|
113 $r->print(<<EHTML); |
|
114 </head> |
|
115 <body> |
|
116 EHTML |
|
117 } |
|
118 |
|
119 $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}; |
|
121 if ($opt{legend}) { |
|
122 $r->print(<<EHTML); |
|
123 <div class="legend"> |
|
124 <span class="done"> </span> Item completed<br /> |
|
125 <span class="todo"> </span> Item is incomplete<br /> |
|
126 </div> |
|
127 EHTML |
|
128 } |
|
129 if ($opt{sort}) { |
|
130 my %sorts = ( |
|
131 alpha => 'alphabetical', |
|
132 percent => 'percentages', |
|
133 ); |
|
134 $r->print("<div class=\"sort\">Sort: \n"); |
|
135 foreach (sort keys %sorts) { |
|
136 if ($opt{sorttype} eq $_ && $opt{sortrev}) { |
|
137 $r->print("<a href=\"$uri?sorttype=$_\">$sorts{$_}</a> "); |
|
138 } elsif ($opt{sorttype} eq $_ && ! $opt{sortrev}) { |
|
139 $r->print("<a href=\"$uri?sorttype=$_&sortrev=1\">$sorts{$_}</a> "); |
|
140 } else { |
|
141 $r->print("<a href=\"$uri?sorttype=$_\">$sorts{$_}</a> "); |
|
142 } |
|
143 } |
|
144 $r->print("</div>\n"); |
|
145 } |
|
146 |
|
147 my $bc = 0; |
|
148 foreach my $block ( sort { sorter(\%opt, \%re) } @blocks ) { |
|
149 # separate outline items |
|
150 my @items = split /\n/, $block; |
|
151 $r->print("<div class=\"group\">\n") if $opt{divs}; |
|
152 my $lc = 0; |
|
153 |
|
154 # get item counts |
|
155 my ($subs, $comments, $subsubs); |
|
156 if ($opt{counts}) { |
|
157 foreach (@items) { |
|
158 if (/$re{comment}/) { |
|
159 $comments++; |
|
160 } elsif (/$re{subitem}/) { |
|
161 $subs++; |
|
162 } |
|
163 } |
|
164 $subsubs = (scalar @items - 1) - $subs - $comments;; |
|
165 } |
|
166 |
|
167 # parse |
|
168 foreach (@items) { |
|
169 next if /^\#/; |
|
170 my $level = tr/\t/\t/ || 0; |
|
171 next unless /\w/; |
|
172 |
|
173 # append counts |
|
174 if ($lc == 0 && $opt{counts} && $_ !~ $re{comment}) { |
|
175 my $itmstr = $subs == 1 ? 'item' : 'items'; |
|
176 my $sitmstr = $subsubs == 1 ? 'subitem' : 'subitems'; |
|
177 $_ .= " <span class=\"counts\">$subs $itmstr, $subsubs $sitmstr</span>"; |
|
178 } |
|
179 s/^:// if ! $level; |
|
180 |
|
181 if ($opt{js}) { |
|
182 s#(.+)#<span id=\"itemtoplevel_$bc\">$1</span># if $lc == 0; |
|
183 $r->print("<span id=\"itemgroup_$bc\">\n") if $lc == 1; |
|
184 } |
|
185 |
|
186 s#$re{'time'}#<span class="time">$1</span>#g if /$re{'time'}/; |
|
187 s#$re{date}#<span class="date">$1</span>#g if /$re{date}/; |
|
188 s#$re{percent}#$1 <span class="percent">$2%</span># if /$re{percent}/; |
|
189 s#$re{todo}#<span class="todo"> </span># if /$re{todo}/; |
|
190 s#$re{done}#<span class="done"> </span># if /$re{done}/; |
|
191 s#$re{comment}#<span class="comment">$1</span># if /$re{comment}/; |
|
192 s#$re{line_wo_tabs}#<span class="level$level">$1</span>#; |
|
193 |
|
194 $r->print("$_\n"); |
|
195 $lc++; |
|
196 } |
|
197 $r->print("</span>\n") if $opt{js}; |
|
198 $r->print("</div>\n") if $opt{divs}; |
|
199 $r->print("<br /><hr /><br />\n") if $opt{dividers}; |
|
200 $r->print("<br /><br />\n") unless $opt{divs} || $opt{dividers}; |
|
201 $bc++; |
|
202 } |
|
203 |
|
204 my $t1 = Time::HiRes::gettimeofday; |
|
205 my $td = sprintf("%0.3f", $t1 - $t0); |
|
206 $r->print("<div class=\"timer\">OTL parsed in $td secs</div>") if $opt{timer}; |
|
207 $r->print(<<EHTML); |
|
208 </body> |
|
209 </html> |
|
210 EHTML |
|
211 |
|
212 return OK; |
|
213 } |
|
214 |
|
215 sub sorter |
|
216 { |
|
217 my ($opt, $re) = @_; |
|
218 return 0 unless $opt->{sorttype}; |
|
219 my ($sa, $sb); |
|
220 if ($opt->{sorttype} eq 'percent') { |
|
221 $sa = $2 if $a =~ $re->{percent}; |
|
222 $sb = $2 if $b =~ $re->{percent}; |
|
223 return $opt->{sortrev} ? $sb <=> $sa : $sa <=> $sb; |
|
224 } |
|
225 else { |
|
226 $sa = $1 if $a =~ $re->{linetext}; |
|
227 $sb = $1 if $b =~ $re->{linetext}; |
|
228 return $opt->{sortrev} ? $sb cmp $sa : $sa cmp $sb; |
|
229 } |
|
230 } |
|
231 |
|
232 1; |