apidocs.perl

   1 #!perl -w
   2 use strict;
   3 use ExtUtils::Manifest 'maniread';
   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
  13 my $mani = maniread;
  14 my @files = grep /\.(c|im)$/, keys %$mani;
  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 ];
  39         $from{$func} = "File $file";
  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
  77 Each function description has a comment listing the source file where
  78 you can find the documentation.
  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;
  88   i_fill_t *fill = i_new_fill_...(...);
  89
  90 EOS
  91
  92 for my $cat (sort { lc $a cmp lc $b } keys %cats) {
  93   print OUT "\n  # $cat\n";
  94   for my $func (grep $funcsyns{$_}, sort @{$cats{$cat}}) {
  95     my $syn = $funcsyns{$func};
  96     $syn =~ s/^/  /gm;
  97     print OUT $syn;
  98   }
  99 }
 100
 101 print OUT <<'EOS';
 102
 103    i_fill_destroy(fill);
 104
 105 =head1 DESCRIPTION
 106
 107 EOS
 108
 109 my %undoc = %funcs;
 110
 111 for my $cat (sort { lc $a cmp lc $b } keys %cats) {
 112   print OUT "=head2 $cat\n\n=over\n\n";
 113   for my $func (sort @{$cats{$cat}}) {
 114     print OUT @{$alldocs{$func}}, "\n";
 115     print OUT "=for comment\nFrom: $from{$func}\n\n";
 116     delete $undoc{$func};
 117   }
 118   print OUT "\n=back\n\n";
 119 }
 120
 121 # see if we have an uncategorized section
 122 if (grep $alldocs{$_}, keys %undoc) {
 123   print OUT "=head2 Uncategorized functions\n\n=over\n\n";
 124   for my $func (sort @funcs) {
 125     if ($undoc{$func} && $alldocs{$func}) {
 126       print OUT @{$alldocs{$func}}, "\n";
 127       print OUT "=for comment\nFrom: $from{$func}\n\n";
 128       delete $undoc{$func};
 129     }
 130   }
 131   print OUT "\n\n=back\n\n";
 132 }
 133
 134 if (keys %undoc) {
 135   print OUT <<'EOS';
 136
 137 =head1 UNDOCUMENTED
 138
 139 The following API functions are undocumented so far, hopefully this
 140 will change:
 141
 142 =over
 143
 144 EOS
 145
 146   print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc;
 147
 148   print OUT "\n\n=back\n\n";
 149 }
 150
 151 print OUT <<'EOS';
 152
 153 =head1 AUTHOR
 154
 155 Tony Cook <tony@imager.perl.org>
 156
 157 =head1 SEE ALSO
 158
 159 Imager, Imager::ExtUtils, Imager::Inline
 160
 161 =cut
 162 EOS
 163
 164 close OUT;
 165
 166
 167 sub make_func_list {
 168   my $funcs;
 169   open FUNCS, "< imexttypes.h"
 170     or die "Cannot open imexttypes.h: $!\n";
 171   my $in_struct;
 172   while (<FUNCS>) {
 173     /^typedef struct/ && ++$in_struct;
 174     if ($in_struct && /\(\*f_(i_\w+)/) {
 175       push @funcs, $1;
 176     }
 177     if (/^\} im_ext_funcs;$/) {
 178       $in_struct
 179         or die "Found end of functions structure but not the start";
 180
 181       close FUNCS;
 182       return @funcs;
 183     }
 184   }
 185   if ($in_struct) {
 186     die "Found start of the functions structure but not the end\n";
 187   }
 188   else {
 189     die "Found neither the start nor end of the functions structure\n";
 190   }
 191 }