Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

192 lines (151 sloc) 3.861 kB
#!perl -w
use strict;
use ExtUtils::Manifest 'maniread';
my $outname = shift || '-';
my @funcs = make_func_list();
my %funcs = map { $_ => 1 } @funcs;
# look for files to parse
my $mani = maniread;
my @files = grep /\.(c|im)$/, keys %$mani;
# scan each file for =item <func>\b
my $func;
my $start;
my %alldocs;
my @funcdocs;
my %from;
my $category;
my %funccats;
my %cats;
my $synopsis = '';
my %funcsyns;
for my $file (@files) {
open SRC, "< $file"
or die "Cannot open $file for documentation: $!\n";
while (<SRC>) {
if (/^=item (\w+)\b/ && $funcs{$1}) {
$func = $1;
$start = $.;
@funcdocs = $_;
}
elsif ($func && /^=(cut|head)/) {
if ($funcs{$func}) { # only save the API functions
$alldocs{$func} = [ @funcdocs ];
$from{$func} = "File $file";
if ($category) {
$funccats{$func} = $category;
push @{$cats{$category}}, $func;
}
if ($synopsis) {
$funcsyns{$func} = $synopsis;
}
}
undef $func;
undef $category;
$synopsis = '';
}
elsif ($func) {
if (/^=category (.*)/) {
$category = $1;
}
elsif (/^=synopsis (.*)/) {
$synopsis .= "$1\n";
}
else {
push @funcdocs, $_;
}
}
}
$func and
die "Documentation for $func not followed by =cut or =head in $file\n";
close SRC;
}
open OUT, "> $outname"
or die "Cannot open $outname: $!";
print OUT <<'EOS';
Do not edit this file, it is generated automatically by apidocs.perl
from Imager's source files.
Each function description has a comment listing the source file where
you can find the documentation.
=head1 NAME
Imager::APIRef - Imager's C API.
=head1 SYNOPSIS
i_color color;
color.rgba.red = 255; color.rgba.green = 0; color.rgba.blue = 255;
i_fill_t *fill = i_new_fill_...(...);
EOS
for my $cat (sort { lc $a cmp lc $b } keys %cats) {
print OUT "\n # $cat\n";
for my $func (grep $funcsyns{$_}, sort @{$cats{$cat}}) {
my $syn = $funcsyns{$func};
$syn =~ s/^/ /gm;
print OUT $syn;
}
}
print OUT <<'EOS';
i_fill_destroy(fill);
=head1 DESCRIPTION
EOS
my %undoc = %funcs;
for my $cat (sort { lc $a cmp lc $b } keys %cats) {
print OUT "=head2 $cat\n\n=over\n\n";
for my $func (sort @{$cats{$cat}}) {
print OUT @{$alldocs{$func}}, "\n";
print OUT "=for comment\nFrom: $from{$func}\n\n";
delete $undoc{$func};
}
print OUT "\n=back\n\n";
}
# see if we have an uncategorized section
if (grep $alldocs{$_}, keys %undoc) {
print OUT "=head2 Uncategorized functions\n\n=over\n\n";
for my $func (sort @funcs) {
if ($undoc{$func} && $alldocs{$func}) {
print OUT @{$alldocs{$func}}, "\n";
print OUT "=for comment\nFrom: $from{$func}\n\n";
delete $undoc{$func};
}
}
print OUT "\n\n=back\n\n";
}
if (keys %undoc) {
print OUT <<'EOS';
=head1 UNDOCUMENTED
The following API functions are undocumented so far, hopefully this
will change:
=over
EOS
print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc;
print OUT "\n\n=back\n\n";
}
print OUT <<'EOS';
=head1 AUTHOR
Tony Cook <tony@imager.perl.org>
=head1 SEE ALSO
Imager, Imager::ExtUtils, Imager::Inline
=cut
EOS
close OUT;
sub make_func_list {
my $funcs;
open FUNCS, "< imexttypes.h"
or die "Cannot open imexttypes.h: $!\n";
my $in_struct;
while (<FUNCS>) {
/^typedef struct/ && ++$in_struct;
if ($in_struct && /\(\*f_(i_\w+)/) {
push @funcs, $1;
}
if (/^\} im_ext_funcs;$/) {
$in_struct
or die "Found end of functions structure but not the start";
close FUNCS;
return @funcs;
}
}
if ($in_struct) {
die "Found start of the functions structure but not the end\n";
}
else {
die "Found neither the start nor end of the functions structure\n";
}
}
Jump to Line
Something went wrong with that request. Please try again.