]> mj.ucw.cz Git - libucw.git/blob - build/doc-extract
dd01f4c42b7735c16709b224ee36f54bdb480e1e
[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( 'struct', 1, $1, "typedef struct { ... } $1;" ) if /^\s*typedef\s+struct\s*{.*}\s*(\w+)\s*;\s*$/s;
28         return( 'enum', 1, $1, "typedef enum { ... } $1;" ) if /^\s*typedef\s+enum\s*{.*}\s*(\w+)\s*;\s*$/s;
29         my $l = length;
30         s/\n.*//s;
31         return( 'struct', 0, $1, $_ ) if /struct\s+(\w+)\s+{/;
32         return( 'enum', 0, $1, $_ ) if /enum\s+(\w+)\s+{/;
33         if( $l > length ) {
34                 warn( "Unknown statement $_\n" );
35                 return( '', 0, $_, $_ );
36         }
37         return( 'def', 0, $1, $_ ) if /#define\s+(\w+)/;
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         print OUT "..................\n";
62         print OUT "$head\n";
63         print OUT "..................\n\n";
64         if( $hasdump ) {
65                 print DUMP "$outname,${type}_$name,$type,$name,$oneline\n";
66                 $id ++;
67         }
68         print OUT "$comment\n\n";
69 }
70
71 sub process( $ ) {
72         my $file = shift;
73         open FILE, $file or die "Could nod read $file ($!)\n";
74         my $line;
75         my $active;
76         my $verbatim;
77         my $buff;
78         my $head;
79         my $struct;
80         while( defined( $line = <FILE> ) ) {
81                 chomp $line;
82                 if( $struct ) {
83                         $head .= "\n".$line;
84                         if( $line =~ /}/ ) {
85                                 formatNote( $head, $buff );
86                                 $struct = 0;
87                                 $buff = undef;
88                                 $head = undef;
89                         }
90                 } elsif( $verbatim ) {
91                         if( $line =~ /\*\// ) {
92                                 $verbatim = 0;
93                                 print OUT "\n";
94                         } else {
95                                 $line =~ s/^\s*\* ?//;
96                                 print OUT "$line\n";
97                         }
98                 } elsif( $active ) {
99                         if( $line =~ /\*\// ) {
100                                 $active = 0;
101                         } else {
102                                 $line =~ s/^\s*\* ?//;
103                                 $buff .= "$line\n";
104                         }
105                 } else {
106                         if( ( $line =~ /\S/ ) && ( defined $buff ) ) {
107                                 if( $line =~ /\(/ || $line !~ /{/ ) {
108                                         $_ = $line;
109                                         s/^\s*\s?//;
110                                         s/\/\/.*//;
111                                         s/\/\*.*?\*\///gs;
112                                         formatNote( $_, $buff );
113                                         $head = undef;
114                                         $buff = undef;
115                                 } else {
116                                         $head = $line;
117                                         $struct = 1;
118                                 }
119                         } elsif( ( $buff ) = ( $line =~ /\/\*\*\*(.*)\*\*\*\// ) ) {
120                                 $buff =~ s/\s?//;
121                                 print OUT "$buff\n\n";
122                                 $buff = undef;
123                         } elsif( ( $head, $buff ) = ( $line =~ /^(.*)\/\*\*(.*)\*\*\// ) ) {
124                                 $buff =~ s/^\s*//;
125                                 $buff =~ s/\s*$//;
126                                 if( $head =~ /\(/ || $head !~ /{/ ) {
127                                         $head =~ s/^\s*//;
128                                         $head =~ s/\/\*.*?\*\///gs;
129                                         formatNote( $head, $buff );
130                                         $head = undef;
131                                         $buff = undef;
132                                 } else {
133                                         $struct = 1;
134                                 }
135                         } elsif( $line =~ /\/\*\*\*/ ) {
136                                 $verbatim = 1;
137                         } elsif( $line =~ /\/\*\*/ ) {
138                                 $active = 1;
139                         }
140                 }
141         }
142         close FILE;
143 }
144
145 my $line;
146 while( defined( $line = <IN> ) ) {
147         chomp $line;
148         if( my( $fname ) = ( $line =~ /^!!\s*(.*\S)/ ) ) {
149                 $fname = "$basedir/$fname" if( ( $fname !~ /^\// ) && defined $basedir );
150                 process( $fname );
151                 push @deps, $fname;
152         } else {
153                 print OUT "$line\n";
154         }
155 }
156
157 if( defined $depname ) {
158         open DEP, ">>$depname" or die "Could not write dep file $depname ($!)\n";
159         print DEP "$outname:";
160         print DEP " $_" foreach( @deps );
161         print DEP "\n";
162         if( $hasdump ) {
163                 print DEP "$defdump:";
164                 print DEP " $_" foreach( @deps );
165                 print DEP "\n";
166         }
167         close DEP;
168 }
169
170 close IN;
171 close OUT;
172 close DUMP;