]> mj.ucw.cz Git - libucw.git/blob - build/doc-extract
Merge branch 'dev-lib' of ssh://git.ucw.cz/projects/sherlock/GIT/sherlock into dev-lib
[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( 'var', 1, $1, $_ ) if( /\s(\w+);/ );
40         warn( "Unknown statement $_\n" );
41         return( '', 0, $_, $_ );
42 }
43
44 my @deps;
45 my $id = 0;
46
47 sub formatNote( $$ ) {
48         my( $head, $comment ) = @_;
49         $head =~ s/(\S)[ ]+/$1 /g;
50         print OUT "\n";
51         print OUT "''''\n";
52         chomp $head;
53         my( $type, $semicolon, $name, $oneline ) = detect( $head );
54         $oneline =~ s/\s+$//;
55         $oneline =~ s/;?$/;/ if( $semicolon );
56         $head =~ s/;?\s*$/;/ if( $semicolon );
57         $head =~ s/(\.\.\.)/\\$1/g;
58         print OUT "[[${type}_$name]]\n";
59         $head = $oneline if $type eq 'fun';#Remove { from inline functions
60         print OUT "..................\n";
61         print OUT "$head\n";
62         print OUT "..................\n\n";
63         if( $hasdump ) {
64                 print DUMP "$outname,${type}_$name,$type,$name,$oneline\n";
65                 $id ++;
66         }
67         print OUT "$comment\n\n";
68 }
69
70 sub process( $ ) {
71         my $file = shift;
72         open FILE, $file or die "Could nod read $file ($!)\n";
73         my $line;
74         my $active;
75         my $verbatim;
76         my $buff;
77         my $head;
78         my $struct;
79         while( defined( $line = <FILE> ) ) {
80                 chomp $line;
81                 if( $struct ) {
82                         $head .= "\n".$line;
83                         if( $line =~ /}/ ) {
84                                 formatNote( $head, $buff );
85                                 $struct = 0;
86                                 $buff = undef;
87                                 $head = undef;
88                         }
89                 } elsif( $verbatim ) {
90                         if( $line =~ /\*\// ) {
91                                 $verbatim = 0;
92                                 print OUT "\n";
93                         } else {
94                                 $line =~ s/^\s*\* ?//;
95                                 print OUT "$line\n";
96                         }
97                 } elsif( $active ) {
98                         if( $line =~ /\*\// ) {
99                                 $active = 0;
100                         } else {
101                                 $line =~ s/^\s*\* ?//;
102                                 $buff .= "$line\n";
103                         }
104                 } else {
105                         if( ( $line =~ /\S/ ) && ( defined $buff ) ) {
106                                 if( $line =~ /\(/ || $line !~ /{/ ) {
107                                         $_ = $line;
108                                         s/^\s*\s?//;
109                                         s/\/\/.*//;
110                                         s/\/\*.*?\*\///gs;
111                                         formatNote( $_, $buff );
112                                         $head = undef;
113                                         $buff = undef;
114                                 } else {
115                                         $head = $line;
116                                         $struct = 1;
117                                 }
118                         } elsif( ( $buff ) = ( $line =~ /\/\*\*\*(.*)\*\*\*\// ) ) {
119                                 $buff =~ s/\s?//;
120                                 print OUT "$buff\n\n";
121                                 $buff = undef;
122                         } elsif( ( $head, $buff ) = ( $line =~ /^(.*)\/\*\*(.*)\*\*\// ) ) {
123                                 $buff =~ s/^\s*//;
124                                 $buff =~ s/\s*$//;
125                                 if( $head =~ /\(/ || $head !~ /{/ ) {
126                                         $head =~ s/^\s*//;
127                                         $head =~ s/\/\*.*?\*\///gs;
128                                         formatNote( $head, $buff );
129                                         $head = undef;
130                                         $buff = undef;
131                                 } else {
132                                         $struct = 1;
133                                 }
134                         } elsif( $line =~ /\/\*\*\*/ ) {
135                                 $verbatim = 1;
136                         } elsif( $line =~ /\/\*\*/ ) {
137                                 $active = 1;
138                         }
139                 }
140         }
141         close FILE;
142 }
143
144 my $line;
145 while( defined( $line = <IN> ) ) {
146         chomp $line;
147         if( my( $fname ) = ( $line =~ /^!!\s*(.*\S)/ ) ) {
148                 $fname = "$basedir/$fname" if( ( $fname !~ /^\// ) && defined $basedir );
149                 process( $fname );
150                 push @deps, $fname;
151         } else {
152                 print OUT "$line\n";
153         }
154 }
155
156 if( defined $depname ) {
157         open DEP, ">>$depname" or die "Could not write dep file $depname ($!)\n";
158         print DEP "$outname:";
159         print DEP " $_" foreach( @deps );
160         print DEP "\n";
161         if( $hasdump ) {
162                 print DEP "$defdump:";
163                 print DEP " $_" foreach( @deps );
164                 print DEP "\n";
165         }
166         close DEP;
167 }
168
169 close IN;
170 close OUT;
171 close DUMP;