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