dab9dbd8018b93f0e679ca412faa77319a7e3c2a
[imager.git] / 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);
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 }