13 # GNU General Public License for more details. |
13 # GNU General Public License for more details. |
14 # |
14 # |
15 # You should have received a copy of the GNU General Public License |
15 # You should have received a copy of the GNU General Public License |
16 # along with this program. If not, see <http://www.gnu.org/licenses/>. |
16 # along with this program. If not, see <http://www.gnu.org/licenses/>. |
17 |
17 |
|
18 =head1 |
|
19 |
|
20 Reads source and generates documentation, embedded in comments |
|
21 |
|
22 =head1 SYNTAX |
|
23 |
|
24 docgen.pl [B<-o> I<outfile>] [B<-t> I<title>] [B<-f> I<format>] F<infile> [F<infile>] ... |
|
25 |
|
26 =cut |
|
27 |
18 use strict; |
28 use strict; |
19 use warnings; |
29 use warnings; |
|
30 |
|
31 use Pod::Usage; |
|
32 use Getopt::Std; |
|
33 $Getopt::Std::STANDARD_HELP_VERSION = 1; |
|
34 |
|
35 our $VERSION = '0.0.3'; |
|
36 our sub HELP_MESSAGE { |
|
37 pod2usage (-verbose => 2, |
|
38 -noperldoc => 1); |
|
39 } |
|
40 |
|
41 =head1 OPTIONS |
|
42 |
|
43 B<-o> F<outfile> |
|
44 |
|
45 Output file (if not specified - stdout). |
|
46 |
|
47 B<-t> I<title> |
|
48 |
|
49 Title for documentation html page |
|
50 |
|
51 B<-f> [I<html>|I<mdwn>] |
|
52 |
|
53 Output type: html (default) or markdown. |
|
54 |
|
55 B<-p> I<prefix> |
|
56 |
|
57 Prefix to search, by default c-like '///' |
|
58 |
|
59 B<-c> F<css-link> |
|
60 |
|
61 Url to css file to include in html header. |
|
62 |
|
63 =cut |
|
64 |
|
65 our ( $opt_o, $opt_t, $opt_f, $opt_p, $opt_c ) |
|
66 = ( undef, "Docs", 'html', '///', undef ); |
|
67 getopts ( 'o:t:f:p:c:' ); |
|
68 $opt_c = $opt_c ? qq(\n<link rel="stylesheet" href="$opt_c" type="text/css" />) : ""; |
|
69 my $prefix_rx = quotemeta $opt_p; |
20 |
70 |
21 my %docs; |
71 my %docs; |
22 my @tags; |
72 my @tags; |
23 my $inside; |
73 my $inside; |
24 my $harvest; |
74 my $harvest; |
32 |
82 |
33 my $chunk = 0; |
83 my $chunk = 0; |
34 |
84 |
35 while (<SOURCE>) { |
85 while (<SOURCE>) { |
36 if ( $inside ) { |
86 if ( $inside ) { |
37 if ( not /^\/\/\// ) { |
87 if ( /^$prefix_rx\s*G:\s*(.*?)\s*$/o ) { |
|
88 $inside = 0; |
|
89 $harvest = "V: $1"; |
|
90 } elsif ( /^$prefix_rx\s?(.*?)\s*$/o ) { |
|
91 push @{$docs{$file}[$chunk]}, $1; |
|
92 } else { |
38 $inside = 0; |
93 $inside = 0; |
39 $chunk++; |
94 $chunk++; |
40 } elsif ( /^\/\/\/ G:/ ) { |
|
41 $inside = 0; |
|
42 $harvest = 'V: ' . substr ( $_, 6 ); |
|
43 } else { |
|
44 push @{$docs{$file}[$chunk]}, substr ( $_, 4 ); |
|
45 } |
95 } |
46 } elsif ( $harvest ) { |
96 } elsif ( $harvest ) { |
47 if ( /\{\s*NULL.*\}/ ) { |
97 if ( /\{\s*NULL.*\}/o ) { |
48 push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values ); |
98 push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values ); |
49 $harvest = undef; |
99 $harvest = undef; |
50 @values = (); |
100 @values = (); |
51 $chunk++; |
101 $chunk++; |
52 } elsif ( /\{\s*"(.+)".*\}/ ) { |
102 } elsif ( /\{\s*"(.+?)".*\}/o ) { |
53 push @values, $1; |
103 push @values, $1; |
54 } |
104 } |
55 } else { |
105 } elsif ( /^$opt_p\s*(.*?)\s*$/o ) { |
56 next if not /^\/\/\//; |
106 |
57 |
107 my $tag = $1; |
58 $inside = 1; |
108 $inside = 1; |
59 my $tag = substr $_, 4; |
|
60 chomp $tag; |
|
61 push @{$docs{$file}[$chunk]}, $tag; |
109 push @{$docs{$file}[$chunk]}, $tag; |
62 # hack to allow twoword objects be written in text with spaces |
110 # hack to allow twoword objects be written in text with spaces |
63 # now it matches "lm message" instead of "lm message node" -.- |
111 # now it matches "lm message" instead of "lm message node" -.- |
64 # and even if tag list will be reverse sorted by length, |
112 # and even if tag list will be reverse sorted by length, |
65 # it will produce nested links... |
113 # it will produce nested links... |
66 # well, that all is now solved, but in not too impressive way.. |
114 # well, that all is now solved, but in not too impressive way.. |
67 $tag =~ s/_/./g; |
115 $tag =~ s/[_\s]+/./go; |
68 push @tags, $tag; |
116 push @tags, $tag; |
69 } |
117 } |
70 } |
118 } |
71 |
119 |
72 close SOURCE; |
120 close SOURCE; |
73 } |
121 } |
74 |
122 |
75 print <<HEADER |
123 @tags = reverse sort { length $a <=> length $b } @tags; |
|
124 |
|
125 if ( $opt_o ) { |
|
126 open OUTPUT, ">", "$opt_o" |
|
127 or die "Cannot open destination file '$opt_o': $!"; |
|
128 } else { |
|
129 *OUTPUT = *STDOUT; |
|
130 } |
|
131 |
|
132 if ( $opt_f eq 'html' ) { |
|
133 |
|
134 print OUTPUT <<HEADER |
76 <html> |
135 <html> |
77 <head><title>lua-loudmouth docs</title></head> |
136 <head> |
|
137 <title>$opt_t</title>$opt_c |
|
138 </head> |
78 <body> |
139 <body> |
79 HEADER |
140 HEADER |
80 ; |
141 ; |
81 |
142 |
82 @tags = reverse sort { length $a <=> length $b } @tags; |
143 # TODO preserve original order |
83 # TODO preserve original order |
144 foreach my $file ( sort keys %docs ) { |
84 foreach my $file ( sort keys %docs ) { |
145 print OUTPUT "<hr>\n"; |
85 print "<hr>"; |
146 foreach my $chunk ( @{$docs{$file}} ) { |
86 foreach my $chunk ( @{$docs{$file}} ) { |
147 my $head = shift @$chunk; |
87 my $head = shift @$chunk; |
148 my $tag = $head; |
88 my $tag = $head; |
149 my $list = undef; |
89 my $list = undef; |
150 $tag =~ s/[_\s]+/./go; |
90 $tag =~ s/_/./g; |
151 print OUTPUT "<a name='$tag'></a><h2>$head</h2>\n<p>"; |
91 print "<a name='$tag'></a><h2>$head</h2><p>"; |
152 foreach ( @$chunk ) { |
92 foreach ( @$chunk ) { |
153 s/^A: /<br\/><b>Arguments:<\/b> /o; |
93 s/^A: /<br\/>Arguments: /; |
154 s/^R: /<br\/><b>Return values:<\/b> /o; |
94 s/^R: /<br\/>Return values: /; |
155 s/^V: /<br\/><b>Values:<\/b> /o; |
95 s/^V: /<br\/>Values: /; |
156 s/^\[/<br\/><pre>/o; |
96 s/^\[ /<br\/><pre>/; |
157 s/^\]/<\/pre><br\/>/o; |
97 s/^\]/<\/pre><br\/>/; |
158 if ( $list ) { |
98 if ( $list ) { |
159 if ( /^\* /o ) { |
99 if ( /^\* / ) { |
160 s/^\* /<\/li>\n<li>/o; |
100 s/^\* /<\/li><li>/; |
161 } else { |
|
162 s/^/<\/li>\n<\/ul> /o; |
|
163 $list = undef; |
|
164 } |
|
165 } elsif ( /^\* /o ) { |
|
166 s/^\* /<ul>\n<li>/o; |
|
167 $list = 1; |
|
168 } |
|
169 foreach my $tag ( @tags ) { |
|
170 # TODO quotemeta required, but for now |
|
171 # this bug is rather desired... |
|
172 #s/\b$tag\b/<a href="#$tag">$&<\/a>/g; |
|
173 s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge; |
|
174 } |
|
175 print OUTPUT "$_\n"; |
|
176 } |
|
177 print OUTPUT "</li>\n</ul>" if $list; |
|
178 print OUTPUT "</p>\n"; |
|
179 } |
|
180 print OUTPUT "<hr>\n"; |
|
181 } |
|
182 |
|
183 print OUTPUT "</body>\n</html>"; |
|
184 |
|
185 } elsif ( $opt_f eq 'mdwn' ) { |
|
186 |
|
187 foreach my $file ( sort keys %docs ) { |
|
188 print OUTPUT "\n\n- - -"; |
|
189 foreach my $chunk ( @{$docs{$file}} ) { |
|
190 my $head = shift @$chunk; |
|
191 my $tag = $head; |
|
192 my $code = 0; |
|
193 my $list = 0; |
|
194 $tag =~ s/[_\s]+/./go; |
|
195 print OUTPUT qq(\n\n<a name="$tag"></a>\n### $head); |
|
196 foreach (@$chunk) { |
|
197 if ( $code ) { |
|
198 if ( /^\]\s*(.*?)\s*$/o ) { |
|
199 print OUTPUT "\n\n$1 "; |
|
200 $code = 0; |
|
201 } else { |
|
202 print OUTPUT "\n\t$_"; |
|
203 } |
|
204 next; |
|
205 } elsif ( /^\[\s*(.*?)\s*$/o ) { |
|
206 $code = 1; |
|
207 print OUTPUT "\n\n\t$1"; |
|
208 next; |
|
209 } elsif ( $list ) { |
|
210 if ( not /^\* /o ) { |
|
211 $list = 0; |
|
212 print OUTPUT "\n"; |
|
213 } |
|
214 } elsif ( /^\* /o ) { |
|
215 $list = 1; |
|
216 print OUTPUT "\n"; |
|
217 } |
|
218 |
|
219 if ( s/^A: (.*)$/ \n**Arguments:** $1 /o ) { |
|
220 } elsif ( s/^R: (.*)$/ \n**Return values:** $1 /o ) { |
|
221 } elsif ( s/^V: (.*)$/ \n**Values:** $1 /o ) { |
101 } else { |
222 } else { |
102 s/^/<\/li><\/ul> /; |
223 s/^/\n/o; |
103 $list = undef; |
224 } |
104 } |
225 foreach my $tag ( @tags ) { |
105 } elsif ( /^\* / ) { |
226 s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '[' ) { "$1$2" } else { "$1\[$2\](#$tag)" } /ge; |
106 s/^\* /<ul><li>/; |
227 } |
107 $list = 1; |
228 print OUTPUT "$_"; |
108 } |
229 } |
109 foreach my $tag ( @tags ) { |
230 }; |
110 # TODO quotemeta required, but for now |
231 print OUTPUT "\n\n- - -"; |
111 # this bug is rather desired... |
232 } |
112 #s/\b$tag\b/<a href="#$tag">$&<\/a>/g; |
233 |
113 s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge; |
234 } |
114 } |
235 |
115 print $_; |
236 close OUTPUT; |
116 } |
|
117 print "</li></ul>" if $list; |
|
118 print "</p>" |
|
119 } |
|
120 print "<hr>"; |
|
121 } |
|
122 |
|
123 print "</body></html>" |
|
124 |
237 |
125 # The end |
238 # The end |