apidocs.perl

#!perl -w
use strict;

my $outname = shift || '-';


my @funcs = make_func_list();
my %funcs = map { $_ => 1 } @funcs;

# look for files to parse

my @files = grep $_ ne 'Imager.xs', glob '*.c';

# 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} = "Line $start in $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 and
line number 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";
  }
}