Commit | Line | Data |
---|---|---|
92bda632 TC |
1 | #!perl -w |
2 | use strict; | |
3 | ||
4 | my $outname = shift || '-'; | |
5 | ||
6 | ||
7 | my @funcs = make_func_list(); | |
8 | my %funcs = map { $_ => 1 } @funcs; | |
9 | ||
10 | # look for files to parse | |
11 | ||
12 | my @files = grep $_ ne 'Imager.xs', glob '*.c'; | |
13 | ||
14 | # scan each file for =item <func>\b | |
15 | my $func; | |
16 | my $start; | |
17 | my %alldocs; | |
18 | my @funcdocs; | |
19 | my %from; | |
20 | my $category; | |
21 | my %funccats; | |
22 | my %cats; | |
23 | my $synopsis = ''; | |
24 | my %funcsyns; | |
25 | for my $file (@files) { | |
26 | open SRC, "< $file" | |
27 | or die "Cannot open $file for documentation: $!\n"; | |
28 | while (<SRC>) { | |
29 | if (/^=item (\w+)\b/ && $funcs{$1}) { | |
30 | $func = $1; | |
31 | $start = $.; | |
32 | @funcdocs = $_; | |
33 | } | |
34 | elsif ($func && /^=(cut|head)/) { | |
35 | if ($funcs{$func}) { # only save the API functions | |
36 | $alldocs{$func} = [ @funcdocs ]; | |
5ca7e2ab | 37 | $from{$func} = "File $file"; |
92bda632 TC |
38 | if ($category) { |
39 | $funccats{$func} = $category; | |
40 | push @{$cats{$category}}, $func; | |
41 | } | |
42 | if ($synopsis) { | |
43 | $funcsyns{$func} = $synopsis; | |
44 | } | |
45 | } | |
46 | undef $func; | |
47 | undef $category; | |
48 | $synopsis = ''; | |
49 | } | |
50 | elsif ($func) { | |
51 | if (/^=category (.*)/) { | |
52 | $category = $1; | |
53 | } | |
54 | elsif (/^=synopsis (.*)/) { | |
55 | $synopsis .= "$1\n"; | |
56 | } | |
57 | else { | |
58 | push @funcdocs, $_; | |
59 | } | |
60 | } | |
61 | } | |
62 | $func and | |
63 | die "Documentation for $func not followed by =cut or =head in $file\n"; | |
64 | ||
65 | close SRC; | |
66 | } | |
67 | ||
68 | open OUT, "> $outname" | |
69 | or die "Cannot open $outname: $!"; | |
70 | ||
71 | print OUT <<'EOS'; | |
72 | Do not edit this file, it is generated automatically by apidocs.perl | |
73 | from Imager's source files. | |
74 | ||
5ca7e2ab TC |
75 | Each function description has a comment listing the source file where |
76 | you can find the documentation. | |
92bda632 TC |
77 | |
78 | =head1 NAME | |
79 | ||
80 | Imager::APIRef - Imager's C API. | |
81 | ||
82 | =head1 SYNOPSIS | |
83 | ||
84 | i_color color; | |
85 | color.rgba.red = 255; color.rgba.green = 0; color.rgba.blue = 255; | |
86 | i_fill_t *fill = i_new_fill_...(...); | |
87 | ||
88 | EOS | |
89 | ||
90 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { | |
91 | print OUT "\n # $cat\n"; | |
92 | for my $func (grep $funcsyns{$_}, sort @{$cats{$cat}}) { | |
93 | my $syn = $funcsyns{$func}; | |
94 | $syn =~ s/^/ /gm; | |
95 | print OUT $syn; | |
96 | } | |
97 | } | |
98 | ||
99 | print OUT <<'EOS'; | |
100 | ||
101 | i_fill_destroy(fill); | |
102 | ||
103 | =head1 DESCRIPTION | |
104 | ||
105 | EOS | |
106 | ||
107 | my %undoc = %funcs; | |
108 | ||
109 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { | |
110 | print OUT "=head2 $cat\n\n=over\n\n"; | |
111 | for my $func (sort @{$cats{$cat}}) { | |
112 | print OUT @{$alldocs{$func}}, "\n"; | |
113 | print OUT "=for comment\nFrom: $from{$func}\n\n"; | |
114 | delete $undoc{$func}; | |
115 | } | |
116 | print OUT "\n=back\n\n"; | |
117 | } | |
118 | ||
119 | # see if we have an uncategorized section | |
120 | if (grep $alldocs{$_}, keys %undoc) { | |
121 | print OUT "=head2 Uncategorized functions\n\n=over\n\n"; | |
122 | for my $func (sort @funcs) { | |
123 | if ($undoc{$func} && $alldocs{$func}) { | |
124 | print OUT @{$alldocs{$func}}, "\n"; | |
125 | print OUT "=for comment\nFrom: $from{$func}\n\n"; | |
126 | delete $undoc{$func}; | |
127 | } | |
128 | } | |
129 | print OUT "\n\n=back\n\n"; | |
130 | } | |
131 | ||
132 | if (keys %undoc) { | |
133 | print OUT <<'EOS'; | |
134 | ||
135 | =head1 UNDOCUMENTED | |
136 | ||
137 | The following API functions are undocumented so far, hopefully this | |
138 | will change: | |
139 | ||
140 | =over | |
141 | ||
142 | EOS | |
143 | ||
144 | print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc; | |
145 | ||
146 | print OUT "\n\n=back\n\n"; | |
147 | } | |
148 | ||
149 | print OUT <<'EOS'; | |
150 | ||
151 | =head1 AUTHOR | |
152 | ||
153 | Tony Cook <tony@imager.perl.org> | |
154 | ||
155 | =head1 SEE ALSO | |
156 | ||
157 | Imager, Imager::ExtUtils, Imager::Inline | |
158 | ||
159 | =cut | |
160 | EOS | |
161 | ||
162 | close OUT; | |
163 | ||
164 | ||
165 | sub make_func_list { | |
166 | my $funcs; | |
167 | open FUNCS, "< imexttypes.h" | |
168 | or die "Cannot open imexttypes.h: $!\n"; | |
169 | my $in_struct; | |
170 | while (<FUNCS>) { | |
171 | /^typedef struct/ && ++$in_struct; | |
172 | if ($in_struct && /\(\*f_(i_\w+)/) { | |
173 | push @funcs, $1; | |
174 | } | |
175 | if (/^\} im_ext_funcs;$/) { | |
176 | $in_struct | |
177 | or die "Found end of functions structure but not the start"; | |
178 | ||
179 | close FUNCS; | |
180 | return @funcs; | |
181 | } | |
182 | } | |
183 | if ($in_struct) { | |
184 | die "Found start of the functions structure but not the end\n"; | |
185 | } | |
186 | else { | |
187 | die "Found neither the start nor end of the functions structure\n"; | |
188 | } | |
189 | } |