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