1#!/usr/bin/perl -w
2# usage: xen-headers OPTIONS... BASE-DIR INPUT-SUB-DIR...
3#  INPUT-SUB-DIR must be a relative path, and is interpreted
4#  relative to BASE-DIR.  Only files whose names end .h are processed
5# options:
6#   -O HTML-DIR             write html to this directory (mandatory)
7#   -T EXTRA-TITLE-HTML     tail of title string (used in <title>)
8#   -X GLOB | -I GLOB       include/exclude files matching;
9#                            glob patterns matched against /INPUT-SUB-FILE
10#                            first match wins; if no match, files included
11#   -D                      increase debug
12
13# Functionality:
14#  enum values --> selected function or struct
15#  type & function names, macro definitions --> definition
16#  function or struct selected by enum ++> ref to enum value
17
18#  definitions must start in LH column
19#  extra syntax:
20#   `incontents <seq> <shortname> <anchor text html>...
21#                              make a table of contents entry; they
22#                              will be sorted by increasing seq, and
23#                              shortname will be used as the anchor target
24#    /* ` <definition>                          } parse as if <definition>
25#     * ` <definition>                          }  was not commented
26#   enum <name> { // <pattern>* => <func>()     } cross-reference
27#   enum <name> { // <pattern>* => struct <s>   }  enum values
28#
29
30# 1st pass: find where things are defined and what references are wanted
31# 2rd pass: write out output
32
33use strict;
34use warnings;
35
36use Getopt::Long;
37use File::Find;
38use IO::File;
39
40Getopt::Long::Configure('bundling');
41
42our $outdir;
43our $debug=0;
44our $xtitle='';
45our @fglobs;
46
47sub includeexclude {
48    my ($yn, $optobj, $value) = @_;
49    push @fglobs, [ $value, $yn ];
50}
51
52GetOptions("O|output-dir=s" => \$outdir,
53           "D+" => \$debug,
54           "T=s" => \$xtitle,
55           "I=s" => sub { includeexclude(1, @_); },
56           "X=s" => sub { includeexclude(0, @_); })
57    or die;
58
59die unless defined $outdir;
60@ARGV>=2 or die;
61
62my ($basedir,@indirs) = @ARGV;
63
64# general globals
65our $pass;
66our %sdef;
67our @incontents;
68our @outfiles;
69# $sdef{$type}{$name} => {
70#     DefLocs => { "$leaf_path:$lineno" => $leaf_opath ,... }
71#     Xrefs => { "$leaf_path,$lineno" => "$xref", ... }
72#     Used => 1
73# }
74# $type might be  Func Struct Union Enum EnumVal
75
76# provided by the find() function
77our $leaf;
78our $leaf_opath;
79
80# reset at the start of each file
81our $o;
82our $in_enum;
83our @pending_xrefs;
84
85sub compile_fglobs () {
86    local ($_);
87    my $f = "sub file_wanted (\$) {\n    local (\$_) = \"/\$leaf\";\n";
88    foreach my $fglob (@fglobs) {
89        $_ = $fglob->[0];
90        $_ = "**$_**" unless m/[?*]/;
91        s/\W/\\$&/g;
92        s,\\\*\\\*,.*,g;
93        s,\\\*,[^/]*,g;
94        s,\\\?,[^/],g;
95        $f .= "    return $fglob->[1] if m,$_,o;\n";
96    }
97    $f .= "    return 1;\n}\n1;\n";
98    debug(3, $f);
99    eval $f or die "$@ ";
100}
101
102compile_fglobs();
103
104
105sub warning {
106    print STDERR "$leaf:$.: @_\n";
107}
108
109sub debug {
110    my $msglevel = scalar shift @_;
111    return unless $debug >= $msglevel;
112    print STDERR "DEBUG $pass $msglevel @_\n" or die $!;
113}
114
115sub in_enum ($$$) { $in_enum = [ @_ ]; } # [ $enumvalpfx, RefType, $refnamepfx ]
116
117sub aelem ($$$) {
118    my ($ntext,$ytext,$hparams) = @_;
119    return $ntext unless $hparams =~ m/\S/;
120    return "<a $hparams>$ytext</a>";
121}
122
123sub defn ($$$;$$) {
124    my ($text,$type,$name,$hparams,$deref) = @_;
125    $hparams='' if !defined $hparams;
126    debug(2,"DEFN $. $type $name $hparams |$text|");
127    $sdef{$type}{$name}{DefLocs}{"$leaf:$."} = $leaf_opath;
128    $sdef{$type}{$name}{Derefs}{"$leaf:$."} = $deref;
129    my $xrefs = $sdef{$type}{$name}{Xrefs};
130    push @pending_xrefs, values %$xrefs if $xrefs;
131    $hparams .= " name=\"${type}_$name\"" if $sdef{$type}{$name}{Used};
132    return aelem($text, "<strong>$text</strong>", $hparams);
133}
134
135sub norm ($) {
136    local ($_) = @_;
137    my $no = '';
138    while (length) {
139        if (s/^(?:\s|^\W)+//) {
140            $no .= $&;
141        } elsif (s/^(struct|union|enum)\s+(\w+)\b//) {
142            $no .= ahref($&, (ucfirst $1), $2);
143        } elsif (s/^\w+\b//) {
144            $no .= ahref($&, [qw(Func Typedef)], $&);
145        } else {
146            die "$_ ?";
147        }
148    }
149    return $no;
150}
151
152sub sdefval ($$$) {
153    my ($type,$name,$hkey) = @_;
154    $sdef{$type}{$name}{Used} = 1;
155    my $sdef = $sdef{$type}{$name};
156    my $hash = $sdef->{$hkey};
157    if ((scalar keys %$hash) > 1 && !$sdef->{MultiWarned}{$hkey}) {
158        warning("multiple definitions of $type $name: $_")
159            foreach keys %$hash;
160        $sdef->{MultiWarned}{$hkey}=1;
161    }
162    my ($val) = values %$hash;
163    return $val;
164}
165
166sub refhref ($$) {
167    my ($types,$name) = @_;
168    foreach my $type (ref($types) ? @$types : ($types)) {
169        my ($ttype,$tname) = ($type,$name);
170        my $loc = sdefval($ttype,$tname,'DefLocs');
171        for (;;) {
172            my $deref = sdefval($ttype,$tname,'Derefs');
173            last unless $deref;
174            my ($type2,$name2,$loc2);
175            my @deref = @$deref;
176            while (@deref) {
177                ($type2,$name2,@deref) = @deref;
178                $loc2 = sdefval($type2,$name2,'DefLocs');
179                last if defined $loc2;
180            }
181            last unless defined $loc2;
182            ($loc,$ttype,$tname) = ($loc2,$type2,$name2);
183        }
184        next unless defined $loc;
185        return "href=\"$loc#${ttype}_$tname\"";
186    }
187    return '';
188}
189
190sub ahref ($$$) {
191    my ($text,$type,$name) = @_;
192    return aelem($text,$text, refhref($type,$name));
193}
194
195sub defmacro ($) {
196    my ($valname) = @_;
197    if (!$in_enum) {
198        return $valname;
199    } elsif (substr($valname, 0, (length $in_enum->[0])) ne $in_enum->[0]) {
200        warning("in enum expecting $in_enum->[0]* got $valname");
201        return $valname;
202    } else {
203        my $reftype = $in_enum->[1];
204        my $refname = $in_enum->[2].substr($valname, (length $in_enum->[0]));
205        $sdef{$reftype}{$refname}{Xrefs}{$leaf,$.} =
206            "[see <a href=\"$leaf_opath#EnumVal_$valname\">$valname</a>]";
207        $sdef{EnumVal}{$valname}{Used} = 1;
208        return defn($valname,'EnumVal',$valname, refhref($reftype,$refname));
209    }
210}
211
212sub out_xrefs ($) {
213    my ($linemapfunc) = @_;
214    foreach my $xref (@pending_xrefs) {
215        $o .= $linemapfunc->($xref);
216        $o .= "\n";
217    }
218    @pending_xrefs = ();
219}
220
221sub incontents ($$$) {
222    my ($text, $seq, $anchor) = @_;
223    $anchor = "incontents_$anchor";
224    if ($pass==2) {
225        push @incontents, {
226            Seq => $seq,
227            Href => "$leaf_opath#$anchor",
228            Title => $text,
229        };
230    }
231    return "<a name=\"$anchor\"><strong>$text</strong></a>";
232}
233
234sub write_file ($$) {
235    my ($opath, $odata) = @_;
236    my $out = new IO::File "$opath.new", '>' or die "$opath $!";
237    print $out $odata or die $!;
238    rename "$opath.new", "$opath" or die "$opath $!";
239}
240
241sub process_file ($$) {
242    my ($infile, $outfile) = @_;
243    debug(1,"$pass $infile => $outfile");
244    my $in = new IO::File "$infile", '<' or die "$infile $!";
245
246    $o = '';
247    $in_enum = undef;
248    @pending_xrefs = ();
249
250    $o .= "<html><head><title>$leaf - $xtitle</title></head><body><pre>\n";
251
252    while (<$in>) {
253        s/\&/\&amp;/g;
254        s/\</\&lt;/g;
255        s/\>/\&gt;/g;
256
257        if (m/^(.*\`)[ \t]*$/) {
258            my $lhs = $1;
259            out_xrefs(sub { "$1 $_[0]"; });
260        } elsif (m/^\s*$/) {
261            out_xrefs(sub { sprintf "/* %70s */", $_[0]; });
262        }
263
264        # In case of comments, strip " /* ` " and " * ` ";
265        my $lstripped = s,^ \s* /? \* \s* \` \  ,,x ? $&: '';
266
267        # Strip trailing whitespace and perhaps trailing "*/" or "*"
268        s,(?: \s* \* /? )? \s* $,,x or die;
269        my $rstripped = $&;
270
271        # Now the actual functionality:
272
273        debug(3,"$. $_");
274
275        if (!m/^(?: __attribute__ | __pragma__ )\b/x &&
276            s/^( (?: \w+\  )? ) (\w+[a-z]\w+) ( \( .*)$
277             / $1.defn($2,'Func',$2).norm($3) /xe) {
278        } elsif (s/^((struct|union|enum) \  (\w+)) ( \s+ \{ .* )$
279                  / defn($1,(ucfirst $2),$3).norm($4) /xe) {
280            if ($2 eq 'enum') {
281                if (m,/[/*] (\w+)\* \=\&gt\; (\w+)\*\(\),) {
282                    in_enum($1,'Func',$2)
283                } elsif (m,/[/*] (\w+)\* \=\&gt\; (struct) (\w+)\*,) {
284                    in_enum($1,(ucfirst $2),$3);
285                }
286            }
287        } elsif (s/^(typedef \s+ )((struct|union|enum) \  (\w+))
288                      (\s+) (\w+)(\;)$
289                  / norm($1).norm($2).$5.
290                    defn($6,'Typedef',$6,undef,[(ucfirst $3),$4]).
291                    $7 /xe) {
292        } elsif (s/^(typedef \s+) (\w+) (\s+) (\w+) (\;)$
293                  / $1.norm($2).$3.
294                    defn($4,'Typedef',$4,undef,['Typedef',$2]). $5 /xe) {
295        } elsif (s/^( \s* \#define \s+ ) (\w+) ( \s+\S )
296                  / $1.defmacro($2).norm($3) /xe) {
297        } elsif (s/( \`incontents \s+ (\d+) \s+ (\w+) \s+ )(\S .* \S)
298                 / norm($1).incontents($4, $2, $3) /xe) {
299        } else {
300            if (m/^\s*\}/) {
301                $in_enum = undef;
302            }
303            $_ = norm($_);
304        }
305
306        # Write the line out
307
308        if ($pass == 2) {
309            $o .= $lstripped;
310            $o .= $_;
311            $o .= $rstripped;
312        }
313    }
314
315    warning("pending xrefs at end of file") if @pending_xrefs;
316
317    if ($pass == 2) {
318        push @outfiles, [ $leaf, $leaf_opath ];
319        $o .= "</pre></body></html>";
320        write_file($outfile, $o);
321    }
322}
323
324sub output_index () {
325    my $title = "contents - $xtitle";
326    $o = '';
327    $o .= <<END;
328<html><head><title>$title</title></head>
329<body>
330<h1>$title</h1>
331<h2>Starting points</h2>
332<ul>
333END
334    foreach my $ic (sort { $a->{Seq} <=> $b->{Seq} } @incontents) {
335        $o .= "<li><a href=\"$ic->{Href}\">$ic->{Title}</a></li>\n";
336    }
337    $o .= "</ul>\n";
338    my $forkind = sub {
339        my ($type,$desc,$pfx,$sfx) = @_;
340        $o .= "<h2>$desc</h2><ul>\n";
341        foreach my $name (sort keys %{ $sdef{$type} }) {
342            my $href = refhref($type,$name);
343            next unless $href =~ m/\S/;
344            $o .= "<li><a $href>$pfx$name$sfx</a></li>\n";
345        }
346        $o .= "</ul>\n";
347    };
348    $forkind->('Func','Functions','','()');
349    $forkind->('Struct','Structs','struct ','');
350    $forkind->('Enum','Enums and sets of #defines','','');
351    $forkind->('Typedef','Typedefs','typedef ','');
352    $forkind->('EnumVal','Enum values and individual #defines','','');
353    $o .= "</ul>\n<h2>Files</h2><ul>\n";
354    foreach my $of (sort { $a->[0] cmp $b->[0] } @outfiles) {
355        $o .= "<li><a href=\"$of->[1]\">$of->[0]</a></li>\n";
356    }
357    $o .= "</ul></body></html>\n";
358    write_file("$outdir/index.html", $o);
359}
360
361foreach $pass (qw(1 2)) {
362    my $depspath = "$outdir/.deps";
363    my $depsout;
364    if ($pass==2) {
365        $depsout = new IO::File "$depspath.new", 'w' or die $!;
366    }
367
368    find({ wanted =>
369               sub {
370                   return unless m/\.h$/;
371                   stat $File::Find::name or die "$File::Find::name $!";
372                   -f _ or die "$File::Find::name";
373                   substr($File::Find::name, 0, 1+length $basedir)
374                       eq "$basedir/"
375                       or die "$File::Find::name $basedir";
376                   $leaf = substr($File::Find::name, 1+length $basedir);
377                   if (!file_wanted()) {
378                       debug(1,"$pass $File::Find::name excluded");
379                       return;
380                   }
381                   $leaf_opath = $leaf;
382                   $leaf_opath =~ s#/#,#g;
383                   $leaf_opath .= ".html";
384                   print $depsout "$outdir/index.html: $File::Find::name\n"
385                       or die $!
386                       if $pass==2;
387                   process_file($File::Find::name, $outdir.'/'.$leaf_opath);
388           },
389           no_chdir => 1,
390         },
391         map { "$basedir/$_" } @indirs);
392
393    if ($pass==2) {
394        close $depsout or die $!;
395        rename "$depspath.new", "$depspath" or die $!;
396    }
397}
398
399output_index();
400