]> mj.ucw.cz Git - libucw.git/blob - build/doc-extract
Doc: Described ff-binary.
[libucw.git] / build / doc-extract
1 #!/usr/bin/perl
2 # Script for extracting documentation out of header files
3 # (c) 2008 Michal Vaner <vorner@ucw.cz>
4
5 use strict;
6 use warnings;
7
8 my( $inname, $outname, $depname, $basedir, $defdump ) = @ARGV;
9 if( defined $inname ) {
10         open IN, $inname or die "Could not read $inname ($!)\n";
11 } else {
12         open IN, "<&STDIN" or die "Could not read stdin ($!)\n";
13 }
14 if( defined $outname ) {
15         open OUT, ">$outname" or die "Could not write $outname ($!)\n";
16 } else {
17         open OUT, ">&STDOUT" or die "Could not write to stdout ($!)\n";
18 }
19 my $hasdump;
20 if( defined $defdump ) {
21         open DUMP, ">$defdump" or die "Could not write definition dump $defdump ($!)\n";
22         $hasdump = 1;
23 }
24
25 sub detect( $ ) {
26         ( $_ ) = @_;
27         return( $1, 1, $2, "typedef $1 { ... } $2;" ) if /^\s*typedef\s+(struct|enum)\s*{.*}\s*(\w+)\s*;\s*$/s;
28         return( $1, 1, $2, $_ ) if /^\s*(struct|enum)\s+(\w+)\s*;\s*$/s;
29         my $l = length;
30         s/\n.*//s;
31         return( $1, 0, $2, $_ ) if /(struct|enum)\s+(\w+)\s+{/;
32         return( 'def', 0, $1, $_ ) if /#define\s+(\w+)/;
33         if( $l > length ) {
34                 warn( "Unknown multiline statement $_\n" );
35                 return( '', 0, $_, $_ );
36         }
37         return( 'type', 1, $2, $_ ) if /^\s*typedef[^()]+?(\(\s*?\*\s*?)?(\w+)(\s*\))?\s*\(.*\)/;
38         return( 'fun', 1, $2, $1 ) if /^(.*?(\w+)\([^{]*\)[^{]*)/;
39         return( 'type', 1, $1, $_ ) if /^\s*typedef.*?(\w+);/;
40         return( 'var', 1, $1, $_ ) if /\s\**(\w+);/;
41         warn( "Unknown statement $_\n" );
42         return( '', 0, $_, $_ );
43 }
44
45 my @deps;
46 my $id = 0;
47
48 sub formatNote( $$ ) {
49         my( $head, $comment ) = @_;
50         $head =~ s/(\S)[ ]+/$1 /g;
51         print OUT "\n";
52         print OUT "''''\n";
53         chomp $head;
54         my( $type, $semicolon, $name, $oneline ) = detect( $head );
55         $oneline =~ s/\s+$//;
56         $oneline =~ s/;?$/;/ if( $semicolon );
57         $head =~ s/;?\s*$/;/ if( $semicolon );
58         $head =~ s/(\.\.\.)/\\$1/g;
59         print OUT "[[${type}_$name]]\n";
60         $head = $oneline if $type eq 'fun';#Remove { from inline functions
61         $head =~ s/_OPEN_PAREN_/(/g;
62         $head =~ s/_CLOSE_PAREN_/)/g;
63         print OUT "..................\n";
64         print OUT "$head\n";
65         print OUT "..................\n\n";
66         if( $hasdump ) {
67                 $oneline =~ s/_OPEN_PAREN_/(/g;
68                 $oneline =~ s/_CLOSE_PAREN_/)/g;
69                 my $symname = $type.'_'.$name;
70                 $name =~ s/_OPEN_PAREN_/(/g;
71                 $name =~ s/_CLOSE_PAREN_/)/g;
72                 print DUMP "$outname,$symname,$type,$name,$oneline\n";
73                 $id ++;
74         }
75         $comment =~ s/_OPEN_PAREN_/(/g;
76         $comment =~ s/_CLOSE_PAREN_/)/g;
77         $comment =~ s/_GENERIC_LINK_\|([^|]+)\|([^|]+)\|/${1}_OPEN_PAREN_${2}_CLOSE_PAREN_/g;
78         print OUT "$comment\n\n";
79 }
80
81 sub process( $$ ) {
82         my( $file, $prefixes ) = @_;
83         open FILE, $file or die "Could nod read $file ($!)\n";
84         my $line;
85         my $active;
86         my $verbatim;
87         my $buff;
88         my $head;
89         my $struct;
90         my $def;
91         while( defined( $line = <FILE> ) ) {
92                 chomp $line;
93                 $line =~ s/$_\(([^()]+)\)/${_}_OPEN_PAREN_${1}_CLOSE_PAREN_/g foreach @{$prefixes};
94                 if( $def ) {
95                         $head .= "\n".$line;
96                         $line =~ s/(\/\*.*?\*\/|\/\/.*)//g;
97                         if( $line !~ /\\\s*$/ ) {
98                                 formatNote( $head, $buff );
99                                 $def = 0;
100                                 $buff = $head = undef;
101                         }
102                 } elsif( $struct ) {
103                         $head .= "\n".$line;
104                         if( $line =~ /}/ ) {
105                                 formatNote( $head, $buff );
106                                 $struct = 0;
107                                 $buff = undef;
108                                 $head = undef;
109                         }
110                 } elsif( $verbatim ) {
111                         if( $line =~ /\*\// ) {
112                                 $verbatim = 0;
113                                 print OUT "\n";
114                         } else {
115                                 $line =~ s/^\s*\* ?//;
116                                 print OUT "$line\n";
117                         }
118                 } elsif( $active ) {
119                         if( $line =~ /\*\// ) {
120                                 $active = 0;
121                         } else {
122                                 $line =~ s/^\s*\* ?//;
123                                 $buff .= "$line\n";
124                         }
125                 } else {
126                         if( ( $line =~ /\S/ ) && ( defined $buff ) ) {
127                                 if( $line =~ /^\s*#define.*\\(\s*(\/\/.*|\/\*.*?\*\/|))*/ ) {
128                                         $head = $line;
129                                         $def = 1;
130                                 } elsif( $line =~ /\(/ || $line !~ /{/ || $line =~ /^\s*#define/ ) {
131                                         $_ = $line;
132                                         s/^\s*\s?//;
133                                         s/\/\/.*//;
134                                         s/\/\*.*?\*\///gs;
135                                         formatNote( $_, $buff );
136                                         $head = undef;
137                                         $buff = undef;
138                                 } else {
139                                         $head = $line;
140                                         $struct = 1;
141                                 }
142                         } elsif( ( $buff ) = ( $line =~ /\/\*\*\*(.*)\*\*\*\// ) ) {
143                                 $buff =~ s/\s?//;
144                                 print OUT "$buff\n\n";
145                                 $buff = undef;
146                         } elsif( ( $head, $buff ) = ( $line =~ /^(.*)\/\*\*(.*)\*\*\// ) ) {
147                                 $buff =~ s/^\s*//;
148                                 $buff =~ s/\s*$//;
149                                 if( $head =~ /\(/ || $head !~ /{/ || $head =~/}/ ) {
150                                         $head =~ s/^\s*//;
151                                         $head =~ s/\/\*.*?\*\///gs;
152                                         formatNote( $head, $buff );
153                                         $head = undef;
154                                         $buff = undef;
155                                 } else {
156                                         $struct = 1;
157                                 }
158                         } elsif( $line =~ /\/\*\*\*/ ) {
159                                 $verbatim = 1;
160                         } elsif( $line =~ /\/\*\*/ ) {
161                                 $active = 1;
162                         }
163                 }
164         }
165         close FILE;
166 }
167
168 my $line;
169 while( defined( $line = <IN> ) ) {
170         chomp $line;
171         my $prefixes;
172         if( my( $fname, $prefixes ) = ( $line =~ /^!!\s*(\S+)(.*)/ ) ) {
173                 $fname = "$basedir/$fname" if( ( $fname !~ /^\// ) && defined $basedir );
174                 process( $fname, [ ( map( {
175                         my( $result ) = /^\s*(.*\S)\s*$/;
176                         $result;
177                 } ( split /,/, $prefixes ) ) ) ] );
178                 push @deps, $fname;
179         } else {
180                 print OUT "$line\n";
181         }
182 }
183
184 if( defined $depname ) {
185         open DEP, ">>$depname" or die "Could not write dep file $depname ($!)\n";
186         print DEP "$outname:";
187         print DEP " $_" foreach( @deps );
188         print DEP "\n";
189         if( $hasdump ) {
190                 print DEP "$defdump:";
191                 print DEP " $_" foreach( @deps );
192                 print DEP "\n";
193         }
194         close DEP;
195 }
196
197 close IN;
198 close OUT;
199 close DUMP;