Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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.