| 1 | #!perl -w |
| 2 | use strict; |
| 3 | use ExtUtils::Manifest 'maniread'; |
| 4 | |
| 5 | my $outname = shift || '-'; |
| 6 | |
| 7 | my @funcs = make_func_list(); |
| 8 | my %funcs = map { $_ => 1 } @funcs; |
| 9 | |
| 10 | # look for files to parse |
| 11 | |
| 12 | my $mani = maniread; |
| 13 | my @files = sort grep /\.(c|im|h)$/, keys %$mani; |
| 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; |
| 26 | my $order; |
| 27 | my %order; |
| 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 ]; |
| 40 | $from{$func} = "File $file"; |
| 41 | if ($category) { |
| 42 | $funccats{$func} = $category; |
| 43 | push @{$cats{$category}}, $func; |
| 44 | } |
| 45 | if ($synopsis) { |
| 46 | $funcsyns{$func} = $synopsis; |
| 47 | } |
| 48 | defined $order or $order = 50; |
| 49 | $order{$func} = $order; |
| 50 | } |
| 51 | undef $func; |
| 52 | undef $category; |
| 53 | undef $order; |
| 54 | $synopsis = ''; |
| 55 | } |
| 56 | elsif ($func) { |
| 57 | if (/^=category (.*)/) { |
| 58 | $category = $1; |
| 59 | } |
| 60 | elsif (/^=synopsis (.*)/) { |
| 61 | unless (length $synopsis) { |
| 62 | push @funcdocs, "\n"; |
| 63 | } |
| 64 | $synopsis .= "$1\n"; |
| 65 | push @funcdocs, " $1\n"; |
| 66 | } |
| 67 | elsif (/^=order (.*)$/) { |
| 68 | $order = $1; |
| 69 | $order =~ /^\d+$/ |
| 70 | or die "=order must specify a number for $func in $file\n"; |
| 71 | } |
| 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 | |
| 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 | |
| 90 | print OUT <<'EOS'; |
| 91 | Do not edit this file, it is generated automatically by apidocs.perl |
| 92 | from Imager's source files. |
| 93 | |
| 94 | Each function description has a comment listing the source file where |
| 95 | you can find the documentation. |
| 96 | |
| 97 | =head1 NAME |
| 98 | |
| 99 | Imager::APIRef - Imager's C API - reference. |
| 100 | |
| 101 | =head1 SYNOPSIS |
| 102 | |
| 103 | i_color color; |
| 104 | color.rgba.r = 255; color.rgba.g = 0; color.rgba.b = 255; |
| 105 | double x[] = { ... }; |
| 106 | double y[] = { ... }; |
| 107 | i_polygon_t poly; |
| 108 | poly.count = sizeof(x) / sizeof(*x); |
| 109 | poly.x = x; |
| 110 | poly.y = y; |
| 111 | |
| 112 | EOS |
| 113 | |
| 114 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { |
| 115 | print OUT "\n # $cat\n"; |
| 116 | my @funcs = @{$cats{$cat}}; |
| 117 | my %orig; |
| 118 | @orig{@funcs} = 0 .. $#funcs; |
| 119 | @funcs = sort { $order{$a} <=> $order{$b} || $orig{$a} <=> $orig{$b} } @funcs; |
| 120 | for my $func (grep $funcsyns{$_}, @funcs) { |
| 121 | my $syn = $funcsyns{$func}; |
| 122 | $syn =~ s/^/ /gm; |
| 123 | print OUT $syn; |
| 124 | } |
| 125 | } |
| 126 | |
| 127 | print OUT <<'EOS'; |
| 128 | |
| 129 | =head1 DESCRIPTION |
| 130 | |
| 131 | EOS |
| 132 | |
| 133 | my %undoc = %funcs; |
| 134 | |
| 135 | for my $cat (sort { lc $a cmp lc $b } keys %cats) { |
| 136 | print OUT "=head2 $cat\n\n=over\n\n"; |
| 137 | my @ordered_funcs = sort { |
| 138 | $order{$a} <=> $order{$b} |
| 139 | || lc $a cmp lc $b |
| 140 | } @{$cats{$cat}}; |
| 141 | for my $func (@ordered_funcs) { |
| 142 | print OUT @{$alldocs{$func}}, "\n"; |
| 143 | print OUT "=for comment\nFrom: $from{$func}\n\n"; |
| 144 | delete $undoc{$func}; |
| 145 | } |
| 146 | print OUT "\n=back\n\n"; |
| 147 | } |
| 148 | |
| 149 | # see if we have an uncategorised section |
| 150 | if (grep $alldocs{$_}, keys %undoc) { |
| 151 | print OUT "=head2 Uncategorized functions\n\n=over\n\n"; |
| 152 | #print join(",", grep !exists $order{$_}, @funcs), "\n"; |
| 153 | for my $func (sort { $order{$a} <=> $order{$b} || $a cmp $b } |
| 154 | grep $undoc{$_} && $alldocs{$_}, @funcs) { |
| 155 | print OUT @{$alldocs{$func}}, "\n"; |
| 156 | print OUT "=for comment\nFrom: $from{$func}\n\n"; |
| 157 | delete $undoc{$func}; |
| 158 | } |
| 159 | print OUT "\n\n=back\n\n"; |
| 160 | } |
| 161 | |
| 162 | if (keys %undoc) { |
| 163 | print OUT <<'EOS'; |
| 164 | |
| 165 | =head1 UNDOCUMENTED |
| 166 | |
| 167 | The following API functions are undocumented so far, hopefully this |
| 168 | will change: |
| 169 | |
| 170 | =over |
| 171 | |
| 172 | EOS |
| 173 | |
| 174 | print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc; |
| 175 | |
| 176 | print OUT "\n\n=back\n\n"; |
| 177 | } |
| 178 | |
| 179 | print OUT <<'EOS'; |
| 180 | |
| 181 | =head1 AUTHOR |
| 182 | |
| 183 | Tony Cook <tonyc@cpan.org> |
| 184 | |
| 185 | =head1 SEE ALSO |
| 186 | |
| 187 | Imager, Imager::API, Imager::ExtUtils, Imager::Inline |
| 188 | |
| 189 | =cut |
| 190 | EOS |
| 191 | |
| 192 | close OUT; |
| 193 | |
| 194 | |
| 195 | sub make_func_list { |
| 196 | my @funcs = |
| 197 | qw(i_img i_color i_fcolor i_fill_t mm_log mm_log i_color_model_t |
| 198 | im_context_t i_img_dim i_img_dim_u im_slot_t |
| 199 | i_polygon_t i_poly_fill_mode_t i_mutex_t |
| 200 | i_img_has_alpha i_DF i_DFc i_DFp i_DFcp i_psamp_bits i_gsamp_bits |
| 201 | i_psamp i_psampf); |
| 202 | open FUNCS, "< imexttypes.h" |
| 203 | or die "Cannot open imexttypes.h: $!\n"; |
| 204 | my $in_struct; |
| 205 | while (<FUNCS>) { |
| 206 | /^typedef struct/ && ++$in_struct; |
| 207 | if ($in_struct && !/SKIP/ && /\(\*f_(i[om]?_\w+)/) { |
| 208 | my $name = $1; |
| 209 | $name =~ s/_imp$//; |
| 210 | push @funcs, $name; |
| 211 | } |
| 212 | if (/^\} im_ext_funcs;$/) { |
| 213 | $in_struct |
| 214 | or die "Found end of functions structure but not the start"; |
| 215 | |
| 216 | close FUNCS; |
| 217 | return @funcs; |
| 218 | } |
| 219 | } |
| 220 | if ($in_struct) { |
| 221 | die "Found start of the functions structure but not the end\n"; |
| 222 | } |
| 223 | else { |
| 224 | die "Found neither the start nor end of the functions structure\n"; |
| 225 | } |
| 226 | } |
| 227 | |
| 228 | =head1 NAME |
| 229 | |
| 230 | apidocs.perl - parse Imager's source for POD documenting the C API |
| 231 | |
| 232 | =head1 SYNOPSIS |
| 233 | |
| 234 | perl apidocs.perl lib/Imager/APIRef.pod |
| 235 | |
| 236 | =head1 DESCRIPTION |
| 237 | |
| 238 | Parses Imager's C sources, including .c, .h and .im files searching |
| 239 | for function documentation. |
| 240 | |
| 241 | Besides the normal POD markup, the following can be included: |
| 242 | |
| 243 | =over |
| 244 | |
| 245 | =item =category I<category-name> |
| 246 | |
| 247 | The category the function should be in. |
| 248 | |
| 249 | =item =synopsis I<sample-code> |
| 250 | |
| 251 | Sample code using the function to include in the Imager::APIRef SYNOPSIS |
| 252 | |
| 253 | =item =order I<integer> |
| 254 | |
| 255 | Allows a function to be listed out of order. If this isn't specified |
| 256 | it defaults to 50, so a value of 10 will cause the function to be |
| 257 | listed at the beginning of its category, or 90 to list at the end. |
| 258 | |
| 259 | Functions with equal order are otherwise ordered by name. |
| 260 | |
| 261 | =back |
| 262 | |
| 263 | =head1 AUTHOR |
| 264 | |
| 265 | Tony Cook <tonyc@cpan.org> |
| 266 | |
| 267 | =cut |
| 268 | |