]> mj.ucw.cz Git - libucw.git/blob - build/doc-extract
UCW: Adapted to use ucw_thread_id()
[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 # Function to guess type of statement
26 sub detect( $ ) {
27         ( $_ ) = @_;
28         # typedef struct|enum { something } name;
29         return( $1, 1, $2, "typedef $1 { ... } $2;" ) if /^\s*typedef\s+(struct|enum)\s*{.*}\s*(\w+)\s*;\s*$/s;
30         # struct|enum name { something };
31         return( $1, 1, $2, $_ ) if /^\s*(struct|enum)\s+(\w+)\s*;\s*$/s;
32         my $l = length;
33         s/\n.*//s;
34         # struct|enum name {
35         #   something
36         # };
37         return( $1, 0, $2, $_ ) if /(struct|enum)\s+(\w+)\s+{/;
38         return( 'def', 0, $1, $_ ) if /#define\s+(\w+)/;
39         if( $l > length ) {
40                 warn( "Unknown multiline statement $_\n" );
41                 return( '', 0, $_, $_ );
42         }
43         # typedef type (*function_type)(params);
44         return( 'type', 1, $2, $_ ) if /^\s*typedef[^()]+?(\(\s*?\*\s*?)?(\w+)(\s*\))?\s*\(.*\)/;
45         # type (*function_var)(params);
46         return( 'var', 1, $1, $_ ) if /^.*?\(\*(\w+)\)\(.*\)/;
47         # type function(name);
48         return( 'fun', 1, $2, $1 ) if /^(.*?(\w+)\([^{]*\)[^{]*)/;
49         # typedef something name;
50         return( 'type', 1, $1, $_ ) if /^\s*typedef.*?(\w+);/;
51         # type name;
52         return( 'var', 1, $1, $_ ) if /\s\**(\w+);/;
53         warn( "Unknown statement $_\n" );
54         return( '', 0, $_, $_ );
55 }
56
57 my @deps;
58 my $id = 0;
59
60 sub formatNote( $$ ) {
61         my( $head, $comment ) = @_;
62         $head =~ s/(\S)[ ]+/$1 /g;
63         print OUT "\n";
64         print OUT "''''\n";
65         chomp $head;
66         my( $type, $semicolon, $name, $oneline ) = detect( $head );
67         # Just few transformations of the result
68         $oneline =~ s/\s+$//;
69         $oneline =~ s/;?$/;/ if( $semicolon );
70         $head =~ s/;?\s*$/;/ if( $semicolon );
71         $head =~ s/(\s|,|\()(\.\.\.)/$1\\$2/g; # Do not convert tripple dot into ellipsis
72         print OUT "[[${type}_$name]]\n";
73         $head = $oneline if $type eq 'fun';#Remove { from inline functions
74         # Remove the generic hack markup
75         $head =~ s/_OPEN_PAREN_/(/g;
76         $head =~ s/_CLOSE_PAREN_/)/g;
77         print OUT "..................\n";
78         print OUT "$head\n";
79         print OUT "..................\n\n";
80         if( $hasdump ) {
81                 $oneline =~ s/_OPEN_PAREN_/(/g;
82                 $oneline =~ s/_CLOSE_PAREN_/)/g;
83                 my $symname = $type.'_'.$name;
84                 $name =~ s/_OPEN_PAREN_/(/g;
85                 $name =~ s/_CLOSE_PAREN_/)/g;
86                 print DUMP "$outname,$symname,$type,$name,$oneline\n";
87                 $id ++;
88         }
89         $comment =~ s/_OPEN_PAREN_/(/g;
90         $comment =~ s/_CLOSE_PAREN_/)/g;
91         $comment =~ s/_GENERIC_LINK_\|([^|]+)\|([^|]+)\|/${1}_OPEN_PAREN_${2}_CLOSE_PAREN_/g;
92         print OUT "$comment\n\n";
93 }
94
95 sub process( $$ ) {
96         my( $file, $prefixes ) = @_;
97         open FILE, $file or die "Could nod read $file ($!)\n";
98         my $line;
99         my $active;
100         my $verbatim;
101         my $buff;
102         my $head;
103         my $struct;
104         my $def;
105         my $sdepth;
106         while( defined( $line = <FILE> ) ) {
107                 chomp $line;
108                 # Generic macro hack - replaces the parenthesis so it is valid identifier
109                 $line =~ s/$_\(([^()]+)\)/${_}_OPEN_PAREN_${1}_CLOSE_PAREN_/g foreach @{$prefixes};
110                 if( $def ) {
111                         $head .= "\n".$line;
112                         $line =~ s/(\/\*.*?\*\/|\/\/.*)//g;
113                         if( $line !~ /\\\s*$/ ) {
114                                 formatNote( $head, $buff );
115                                 $def = 0;
116                                 $buff = $head = undef;
117                         }
118                 } elsif( $struct ) {
119                         $head .= "\n".$line;
120                         my $cp = $line;
121                         $sdepth += ($cp =~ tr/{//);
122                         $sdepth -= ($cp =~ tr/}//);
123                         if( !$sdepth ) {
124                                 formatNote( $head, $buff );
125                                 $struct = 0;
126                                 $buff = undef;
127                                 $head = undef;
128                         }
129                 } elsif( $verbatim ) {
130                         if( $line =~ /\*\// ) {
131                                 $verbatim = 0;
132                                 print OUT "\n";
133                         } else {
134                                 $line =~ s/^\s*\* ?//;
135                                 print OUT "$line\n";
136                         }
137                 } elsif( $active ) {
138                         if( $line =~ /\*\// ) {
139                                 $active = 0;
140                         } else {
141                                 $line =~ s/^\s*\* ?//;
142                                 $buff .= "$line\n";
143                         }
144                 } else {
145                         if( ( $line =~ /\S/ ) && ( defined $buff ) ) {
146                                 if( $line =~ /^\s*#define.*\\(\s*(\/\/.*|\/\*.*?\*\/|))*/ ) {
147                                         $head = $line;
148                                         $def = 1;
149                                 } elsif( $line =~ /\(/ || $line !~ /{/ || $line =~ /^\s*#define/ ) {
150                                         $_ = $line;
151                                         s/^\s*\s?//;
152                                         s/\/\/.*//;
153                                         s/\/\*.*?\*\///gs;
154                                         formatNote( $_, $buff );
155                                         $head = undef;
156                                         $buff = undef;
157                                 } else {
158                                         $head = $line;
159                                         $struct = $sdepth = 1;
160                                 }
161                         } elsif( ( $buff ) = ( $line =~ /\/\*\*\*(.*)\*\*\*\// ) ) {
162                                 $buff =~ s/^\s?//;
163                                 print OUT "$buff\n\n";
164                                 $buff = undef;
165                         } elsif( ( $buff ) = ( $line =~ /^\s*\/\*\*(.*)\*\*\// ) ) {
166                                 $buff =~ s/^\s*//;
167                                 $buff .= "\n";
168                         } elsif( ( $head, $buff ) = ( $line =~ /^(.*)\/\*\*(.*)\*\*\// ) ) {
169                                 $buff =~ s/^\s*//;
170                                 $buff =~ s/\s*$//;
171                                 if( $head =~ /\(/ || $head !~ /{/ || $head =~/}/ ) {
172                                         $head =~ s/^\s*//;
173                                         $head =~ s/\/\*.*?\*\///gs;
174                                         formatNote( $head, $buff );
175                                         $head = undef;
176                                         $buff = undef;
177                                 } else {
178                                         $struct = $sdepth = 1;
179                                 }
180                         } elsif( $line =~ /\/\*\*\*/ ) {
181                                 $verbatim = 1;
182                         } elsif( $line =~ /\/\*\*/ ) {
183                                 $active = 1;
184                         }
185                 }
186         }
187         close FILE;
188 }
189
190 my $line;
191 while( defined( $line = <IN> ) ) {
192         chomp $line;
193         my $prefixes;
194         if( my( $fname, $prefixes ) = ( $line =~ /^!!\s*(\S+)(.*)/ ) ) {
195                 $fname = "$basedir/$fname" if( ( $fname !~ /^\// ) && defined $basedir );
196                 process( $fname, [ ( map( {
197                         my( $result ) = /^\s*(.*\S)\s*$/;
198                         $result;
199                 } ( split /,/, $prefixes ) ) ) ] );
200                 push @deps, $fname;
201         } else {
202                 print OUT "$line\n";
203         }
204 }
205
206 if( defined $depname ) {
207         open DEP, ">>$depname" or die "Could not write dep file $depname ($!)\n";
208         print DEP "$outname:";
209         print DEP " $_" foreach( @deps );
210         print DEP "\n";
211         if( $hasdump ) {
212                 print DEP "$defdump:";
213                 print DEP " $_" foreach( @deps );
214                 print DEP "\n";
215         }
216         close DEP;
217 }
218
219 close IN;
220 close OUT;
221 close DUMP;