apidocs.perl

   1 #!perl -w
   2 use strict;
   3
   4 my $outname = shift || '-';
   5
   6
   7 my @funcs = make_func_list();
   8 my %funcs = map { $_ => 1 } @funcs;
   9
  10 # look for files to parse
  11
  12 my @files = grep $_ ne 'Imager.xs', glob '*.c';
  13
  14 # scan each file for =item <func>\b
  15 my $func;
  16 my $start;
  17 my %alldocs;
  18 my @funcdocs;
  19 my %from;
  20 my $category;
  21 my %funccats;
  22 my %cats;
  23 my $synopsis = '';
  24 my %funcsyns;
  25 for my $file (@files) {
  26   open SRC, "< $file"
  27     or die "Cannot open $file for documentation: $!\n";
  28   while (<SRC>) {
  29     if (/^=item (\w+)\b/ && $funcs{$1}) {
  30       $func = $1;
  31       $start = $.;
  32       @funcdocs = $_;
  33     }
  34     elsif ($func && /^=(cut|head)/) {
  35       if ($funcs{$func}) { # only save the API functions
  36         $alldocs{$func} = [ @funcdocs ];
  37         $from{$func} = "Line $start in $file";
  38         if ($category) {
  39           $funccats{$func} = $category;
  40           push @{$cats{$category}}, $func;
  41         }
  42         if ($synopsis) {
  43           $funcsyns{$func} = $synopsis;
  44         }
  45       }
  46       undef $func;
  47       undef $category;
  48       $synopsis = '';
  49     }
  50     elsif ($func) {
  51       if (/^=category (.*)/) {
  52         $category = $1;
  53       }
  54       elsif (/^=synopsis (.*)/) {
  55         $synopsis .= "$1\n";
  56       }
  57       else {
  58         push @funcdocs, $_;
  59       }
  60     }
  61   }
  62   $func and
  63     die "Documentation for $func not followed by =cut or =head in $file\n";
  64
  65   close SRC;
  66 }
  67
  68 open OUT, "> $outname"
  69   or die "Cannot open $outname: $!";
  70
  71 print OUT <<'EOS';
  72 Do not edit this file, it is generated automatically by apidocs.perl
  73 from Imager's source files.
  74
  75 Each function description has a comment listing the source file and
  76 line number where you can find the documentation.
  77
  78 =head1 NAME
  79
  80 Imager::APIRef - Imager's C API.
  81
  82 =head1 SYNOPSIS
  83
  84   i_color color;
  85   color.rgba.red = 255; color.rgba.green = 0; color.rgba.blue = 255;
  86   i_fill_t *fill = i_new_fill_...(...);
  87
  88 EOS
  89
  90 for my $cat (sort { lc $a cmp lc $b } keys %cats) {
  91   print OUT "\n  # $cat\n";
  92   for my $func (grep $funcsyns{$_}, sort @{$cats{$cat}}) {
  93     my $syn = $funcsyns{$func};
  94     $syn =~ s/^/  /gm;
  95     print OUT $syn;
  96   }
  97 }
  98
  99 print OUT <<'EOS';
 100
 101    i_fill_destroy(fill);
 102
 103 =head1 DESCRIPTION
 104
 105 EOS
 106
 107 my %undoc = %funcs;
 108
 109 for my $cat (sort { lc $a cmp lc $b } keys %cats) {
 110   print OUT "=head2 $cat\n\n=over\n\n";
 111   for my $func (sort @{$cats{$cat}}) {
 112     print OUT @{$alldocs{$func}}, "\n";
 113     print OUT "=for comment\nFrom: $from{$func}\n\n";
 114     delete $undoc{$func};
 115   }
 116   print OUT "\n=back\n\n";
 117 }
 118
 119 # see if we have an uncategorized section
 120 if (grep $alldocs{$_}, keys %undoc) {
 121   print OUT "=head2 Uncategorized functions\n\n=over\n\n";
 122   for my $func (sort @funcs) {
 123     if ($undoc{$func} && $alldocs{$func}) {
 124       print OUT @{$alldocs{$func}}, "\n";
 125       print OUT "=for comment\nFrom: $from{$func}\n\n";
 126       delete $undoc{$func};
 127     }
 128   }
 129   print OUT "\n\n=back\n\n";
 130 }
 131
 132 if (keys %undoc) {
 133   print OUT <<'EOS';
 134
 135 =head1 UNDOCUMENTED
 136
 137 The following API functions are undocumented so far, hopefully this
 138 will change:
 139
 140 =over
 141
 142 EOS
 143
 144   print OUT "=item *\n\nB<$_>\n\n" for sort keys %undoc;
 145
 146   print OUT "\n\n=back\n\n";
 147 }
 148
 149 print OUT <<'EOS';
 150
 151 =head1 AUTHOR
 152
 153 Tony Cook <tony@imager.perl.org>
 154
 155 =head1 SEE ALSO
 156
 157 Imager, Imager::ExtUtils, Imager::Inline
 158
 159 =cut
 160 EOS
 161
 162 close OUT;
 163
 164
 165 sub make_func_list {
 166   my $funcs;
 167   open FUNCS, "< imexttypes.h"
 168     or die "Cannot open imexttypes.h: $!\n";
 169   my $in_struct;
 170   while (<FUNCS>) {
 171     /^typedef struct/ && ++$in_struct;
 172     if ($in_struct && /\(\*f_(i_\w+)/) {
 173       push @funcs, $1;
 174     }
 175     if (/^\} im_ext_funcs;$/) {
 176       $in_struct
 177         or die "Found end of functions structure but not the start";
 178
 179       close FUNCS;
 180       return @funcs;
 181     }
 182   }
 183   if ($in_struct) {
 184     die "Found start of the functions structure but not the end\n";
 185   }
 186   else {
 187     die "Found neither the start nor end of the functions structure\n";
 188   }
 189 }