Commit | Line | Data |
---|---|---|
92bda632 TC |
1 | #!perl -w |
2 | use strict; | |
fe415ad2 | 3 | use ExtUtils::Manifest 'maniread'; |
92bda632 TC |
4 | |
5 | my $outname = shift || '-'; | |
6 | ||
92bda632 TC |
7 | my @funcs = make_func_list(); |
8 | my %funcs = map { $_ => 1 } @funcs; | |
9 | ||
10 | # look for files to parse | |
11 | ||
fe415ad2 | 12 | my $mani = maniread; |
bd8052a6 | 13 | my @files = grep /\.(c|im|h)$/, keys %$mani; |
92bda632 TC |
14 | |
15 | # scan each file for =item <func>\b | |
16 | my $func; | |
17 | my $start; | |
18 | my %alldocs; | |
19 | my @funcdocs; | |
20 | my %from; | |
21 | my $category; | |
22 | my %funccats; | |
23 | my %cats; | |
24 | my $synopsis = ''; | |
25 | my %funcsyns; | |
6cfee9d1 TC |
26 | my $order; |
27 | my %order; | |
92bda632 TC |
28 | for my $file (@files) { |
29 | open SRC, "< $file" | |
30 | or die "Cannot open $file for documentation: $!\n"; | |
31 | while (<SRC>) { | |
32 | if (/^=item (\w+)\b/ && $funcs{$1}) { | |
33 | $func = $1; | |
34 | $start = $.; | |
35 | @funcdocs = $_; | |
36 | } | |
37 | elsif ($func && /^=(cut|head)/) { | |
38 | if ($funcs{$func}) { # only save the API functions | |
39 | $alldocs{$func} = [ @funcdocs ]; | |
5ca7e2ab | 40 | $from{$func} = "File $file"; |
92bda632 TC |
41 | if ($category) { |
42 | $funccats{$func} = $category; | |
43 | push @{$cats{$category}}, $func; | |
44 | } | |
45 | if ($synopsis) { | |
46 | $funcsyns{$func} = $synopsis; | |
47 | } | |
6cfee9d1 TC |
48 | defined $order or $order = 50; |
49 | $order{$func} = $order; | |
92bda632 TC |
50 | } |
51 | undef $func; | |
52 | undef $category; | |
6cfee9d1 | 53 | undef $order; |
92bda632 TC |
54 | $synopsis = ''; |
55 | } | |
56 | elsif ($func) { | |
57 | if (/^=category (.*)/) { | |
58 | $category = $1; | |
59 | } | |
60 | elsif (/^=synopsis (.*)/) { | |
8d14daab TC |
61 | unless (length $synopsis) { |
62 | push @funcdocs, "\n"; | |
63 | } | |
92bda632 | 64 | $synopsis .= "$1\n"; |
8d14daab | 65 | push @funcdocs, " $1\n"; |
92bda632 | 66 | } |
6cfee9d1 TC |
67 | elsif (/^=order (.*)$/) { |
68 | $order = $1; | |
69 | $order =~ /^\d+$/ | |
70 | or die "=order must specify a number for $func in $file\n"; | |
71 | } | |
92bda632 TC |
72 | else { |
73 | push @funcdocs, $_; | |
74 | } | |
75 | } | |
76 | } | |
77 | $func and | |
78 | die "Documentation for $func not followed by =cut or =head in $file\n"; | |
79 | ||
80 | close SRC; | |
81 | } | |
82 | ||
83 | open OUT, "> $outname" | |
84 | or die "Cannot open $outname: $!"; | |
85 | ||
091760c5 TC |
86 | # I keep this file in git and as part of the dist, make sure newlines |
87 | # don't mess me up | |
88 | binmode OUT; | |
89 | ||
92bda632 TC |
90 | print OUT <<'EOS'; |
91 | Do not edit this file, it is generated automatically by apidocs.perl | |
92 | from Imager's source files. | |
93 | ||
5ca7e2ab TC |
94 | Each function description has a comment listing the source file where |
95 | you can find the documentation. | |
92bda632 TC |
96 | |
97 | =head1 NAME | |
98 | ||
6cfee9d1 | 99 | Imager::APIRef - Imager's C API - reference. |
92bda632 TC |
100 | |
101 | =head1 SYNOPSIS | |
102 | ||
103 | i_color color; | |
6cfee9d1 | 104 | color.rgba.r = 255; color.rgba.g = 0; color.rgba.b = 255; |
92bda632 TC |
105 | |
106 | EOS | |
107 | ||
108 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { | |
109 | print OUT "\n # $cat\n"; | |
6cfee9d1 | 110 | for my $func (grep $funcsyns{$_}, sort { $order{$a} <=> $order{$b} } @{$cats{$cat}}) { |
92bda632 TC |
111 | my $syn = $funcsyns{$func}; |
112 | $syn =~ s/^/ /gm; | |
113 | print OUT $syn; | |
114 | } | |
115 | } | |
116 | ||
117 | print OUT <<'EOS'; | |
118 | ||
92bda632 TC |
119 | =head1 DESCRIPTION |
120 | ||
121 | EOS | |
122 | ||
123 | my %undoc = %funcs; | |
124 | ||
125 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { | |
126 | print OUT "=head2 $cat\n\n=over\n\n"; | |
6cfee9d1 TC |
127 | my @ordered_funcs = sort { |
128 | $order{$a} <=> $order{$b} | |
129 | || lc $a cmp lc $b | |
130 | } @{$cats{$cat}}; | |
131 | for my $func (@ordered_funcs) { | |
92bda632 TC |
132 | print OUT @{$alldocs{$func}}, "\n"; |
133 | print OUT "=for comment\nFrom: $from{$func}\n\n"; | |
134 | delete $undoc{$func}; | |
135 | } | |
136 | print OUT "\n=back\n\n"; | |
137 | } | |
138 | ||
50c75381 | 139 | # see if we have an uncategorised section |
92bda632 TC |
140 | if (grep $alldocs{$_}, keys %undoc) { |
141 | print OUT "=head2 Uncategorized functions\n\n=over\n\n"; | |
6cfee9d1 TC |
142 | #print join(",", grep !exists $order{$_}, @funcs), "\n"; |
143 | for my $func (sort { $order{$a} <=> $order{$b} || $a cmp $b } | |
144 | grep $undoc{$_} && $alldocs{$_}, @funcs) { | |
145 | print OUT @{$alldocs{$func}}, "\n"; | |
146 | print OUT "=for comment\nFrom: $from{$func}\n\n"; | |
147 | delete $undoc{$func}; | |
92bda632 TC |
148 | } |
149 | print OUT "\n\n=back\n\n"; | |
150 | } | |
151 | ||
152 | if (keys %undoc) { | |
153 | print OUT <<'EOS'; | |
154 | ||
155 | =head1 UNDOCUMENTED | |
156 | ||
157 | The following API functions are undocumented so far, hopefully this | |
158 | will change: | |
159 | ||
160 | =over | |
161 | ||
162 | EOS | |
163 | ||
164 | print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc; | |
165 | ||
166 | print OUT "\n\n=back\n\n"; | |
167 | } | |
168 | ||
169 | print OUT <<'EOS'; | |
170 | ||
171 | =head1 AUTHOR | |
172 | ||
5b480b14 | 173 | Tony Cook <tonyc@cpan.org> |
92bda632 TC |
174 | |
175 | =head1 SEE ALSO | |
176 | ||
177 | Imager, Imager::ExtUtils, Imager::Inline | |
178 | ||
179 | =cut | |
180 | EOS | |
181 | ||
182 | close OUT; | |
183 | ||
184 | ||
185 | sub make_func_list { | |
8d14daab | 186 | my @funcs = qw(i_img i_color i_fcolor i_fill_t mm_log i_img_color_channels i_img_has_alpha i_img_dim i_DF i_DFc i_DFp i_DFcp); |
92bda632 TC |
187 | open FUNCS, "< imexttypes.h" |
188 | or die "Cannot open imexttypes.h: $!\n"; | |
189 | my $in_struct; | |
190 | while (<FUNCS>) { | |
191 | /^typedef struct/ && ++$in_struct; | |
6d5c85a2 TC |
192 | if ($in_struct && /\(\*f_(io?_\w+)/) { |
193 | my $name = $1; | |
194 | $name =~ s/_imp$//; | |
195 | push @funcs, $name; | |
92bda632 TC |
196 | } |
197 | if (/^\} im_ext_funcs;$/) { | |
198 | $in_struct | |
199 | or die "Found end of functions structure but not the start"; | |
200 | ||
201 | close FUNCS; | |
202 | return @funcs; | |
203 | } | |
204 | } | |
205 | if ($in_struct) { | |
206 | die "Found start of the functions structure but not the end\n"; | |
207 | } | |
208 | else { | |
209 | die "Found neither the start nor end of the functions structure\n"; | |
210 | } | |
211 | } | |
6cfee9d1 TC |
212 | |
213 | =head1 NAME | |
214 | ||
215 | apidocs.perl - parse Imager's source for POD documenting the C API | |
216 | ||
217 | =head1 SYNOPSIS | |
218 | ||
219 | perl apidocs.perl lib/Imager/APIRef.pod | |
220 | ||
221 | =head1 DESCRIPTION | |
222 | ||
223 | Parses Imager's C sources, including .c, .h and .im files searching | |
224 | for function documentation. | |
225 | ||
226 | Besides the normal POD markup, the following can be included: | |
227 | ||
228 | =over | |
229 | ||
230 | =item =category I<category-name> | |
231 | ||
232 | The category the function should be in. | |
233 | ||
234 | =item =synopsis I<sample-code> | |
235 | ||
236 | Sample code using the function to include in the Imager::APIRef SYNOPSIS | |
237 | ||
238 | =item =order I<integer> | |
239 | ||
240 | Allows a function to be listed out of order. If this isn't specified | |
241 | it defaults to 50, so a value of 10 will cause the function to be | |
242 | listed at the beginning of its category, or 90 to list at the end. | |
243 | ||
244 | Functions with equal order are otherwise ordered by name. | |
245 | ||
246 | =back | |
247 | ||
248 | =head1 AUTHOR | |
249 | ||
250 | Tony Cook <tonyc@cpan.org> | |
251 | ||
252 | =cut | |
253 |