#!/usr/bin/perl -w
# usage: xen-headers OPTIONS... BASE-DIR INPUT-SUB-DIR...
#  INPUT-SUB-DIR must be a relative path, and is interpreted
#  relative to BASE-DIR.  Only files whose names end .h are processed
# options:
#   -O HTML-DIR             write html to this directory (mandatory)
#   -T EXTRA-TITLE-HTML     tail of title string (used in <title>)
#   -X GLOB | -I GLOB       include/exclude files matching;
#                            glob patterns matched against /INPUT-SUB-FILE
#                            first match wins; if no match, files included
#   -D                      increase debug

# Functionality:
#  enum values --> selected function or struct
#  type & function names, macro definitions --> definition
#  function or struct selected by enum ++> ref to enum value

#  definitions must start in LH column
#  extra syntax:
#   `incontents <seq> <shortname> <anchor text html>...
#                              make a table of contents entry; they
#                              will be sorted by increasing seq, and
#                              shortname will be used as the anchor target
#    /* ` <definition>                          } parse as if <definition>
#     * ` <definition>                          }  was not commented
#   enum <name> { // <pattern>* => <func>()     } cross-reference
#   enum <name> { // <pattern>* => struct <s>   }  enum values
#   

# 1st pass: find where things are defined and what references are wanted
# 2rd pass: write out output

use strict;
use warnings;

use Getopt::Long;
use File::Find;
use IO::File;

Getopt::Long::Configure('bundling');

our $outdir;
our $debug=0;
our $xtitle='';
our @fglobs;

sub includeexclude {
    my ($yn, $optobj, $value) = @_;
    push @fglobs, [ $value, $yn ];
}

GetOptions("O|output-dir=s" => \$outdir,
           "D+" => \$debug,
           "T=s" => \$xtitle,
           "I=s" => sub { includeexclude(1, @_); },
           "X=s" => sub { includeexclude(0, @_); })
    or die;

die unless defined $outdir;
@ARGV>=2 or die;

my ($basedir,@indirs) = @ARGV;

# general globals
our $pass;
our %sdef; 
our @incontents;
our @outfiles;
# $sdef{$type}{$name} => {
#     DefLocs => { "$leaf_path:$lineno" => $leaf_opath ,... }
#     Xrefs => { "$leaf_path,$lineno" => "$xref", ... }
#     Used => 1
# }
# $type might be  Func Struct Union Enum EnumVal

# provided by the find() function
our $leaf;
our $leaf_opath;

# reset at the start of each file
our $o;
our $in_enum;
our @pending_xrefs;

sub compile_fglobs () {
    local ($_);
    my $f = "sub file_wanted (\$) {\n    local (\$_) = \"/\$leaf\";\n";
    foreach my $fglob (@fglobs) {
        $_ = $fglob->[0];
        $_ = "**$_**" unless m/[?*]/;
        s/\W/\\$&/g;
        s,\\\*\\\*,.*,g;
        s,\\\*,[^/]*,g;
        s,\\\?,[^/],g;
        $f .= "    return $fglob->[1] if m,$_,o;\n";
    }
    $f .= "    return 1;\n}\n1;\n";
    debug(3, $f);
    eval $f or die "$@ ";
}

compile_fglobs();


sub warning {
    print STDERR "$leaf:$.: @_\n";
}

sub debug {
    my $msglevel = scalar shift @_;
    return unless $debug >= $msglevel;
    print STDERR "DEBUG $pass $msglevel @_\n" or die $!;
}

sub in_enum ($$$) { $in_enum = [ @_ ]; } # [ $enumvalpfx, RefType, $refnamepfx ]

sub aelem ($$$) {
    my ($ntext,$ytext,$hparams) = @_;
    return $ntext unless $hparams =~ m/\S/;
    return "<a $hparams>$ytext</a>";
}

sub defn ($$$;$$) {
    my ($text,$type,$name,$hparams,$deref) = @_;
    $hparams='' if !defined $hparams;
    debug(2,"DEFN $. $type $name $hparams |$text|");
    $sdef{$type}{$name}{DefLocs}{"$leaf:$."} = $leaf_opath;
    $sdef{$type}{$name}{Derefs}{"$leaf:$."} = $deref;
    my $xrefs = $sdef{$type}{$name}{Xrefs};
    push @pending_xrefs, values %$xrefs if $xrefs;
    $hparams .= " name=\"${type}_$name\"" if $sdef{$type}{$name}{Used};
    return aelem($text, "<strong>$text</strong>", $hparams);
}

sub norm ($) {
    local ($_) = @_;
    my $no = '';
    while (length) {
        if (s/^(?:\s|^\W)+//) {
            $no .= $&;
        } elsif (s/^(struct|union|enum)\s+(\w+)\b//) {
            $no .= ahref($&, (ucfirst $1), $2);
        } elsif (s/^\w+\b//) {
            $no .= ahref($&, [qw(Func Typedef)], $&);
        } else {
            die "$_ ?";
        }
    }
    return $no;
}

sub sdefval ($$$) {
    my ($type,$name,$hkey) = @_;
    $sdef{$type}{$name}{Used} = 1;
    my $sdef = $sdef{$type}{$name};
    my $hash = $sdef->{$hkey};
    if ((scalar keys %$hash) > 1 && !$sdef->{MultiWarned}{$hkey}) {
        warning("multiple definitions of $type $name: $_")
            foreach keys %$hash;
        $sdef->{MultiWarned}{$hkey}=1;
    }
    my ($val) = values %$hash;
    return $val;
}

sub refhref ($$) {
    my ($types,$name) = @_;
    foreach my $type (ref($types) ? @$types : ($types)) {
        my ($ttype,$tname) = ($type,$name);
        my $loc = sdefval($ttype,$tname,'DefLocs');
        for (;;) {
            my $deref = sdefval($ttype,$tname,'Derefs');
            last unless $deref;
            my ($type2,$name2,$loc2);
            my @deref = @$deref;
            while (@deref) {
                ($type2,$name2,@deref) = @deref;
                $loc2 = sdefval($type2,$name2,'DefLocs');
                last if defined $loc2;
            }
            last unless defined $loc2;
            ($loc,$ttype,$tname) = ($loc2,$type2,$name2);
        }
        next unless defined $loc;
        return "href=\"$loc#${ttype}_$tname\"";
    }
    return '';
}

sub ahref ($$$) {
    my ($text,$type,$name) = @_;
    return aelem($text,$text, refhref($type,$name));
}

sub defmacro ($) {
    my ($valname) = @_;
    if (!$in_enum) {
        return $valname;
    } elsif (substr($valname, 0, (length $in_enum->[0])) ne $in_enum->[0]) {
        warning("in enum expecting $in_enum->[0]* got $valname");
        return $valname;
    } else {
        my $reftype = $in_enum->[1];
        my $refname = $in_enum->[2].substr($valname, (length $in_enum->[0]));
        $sdef{$reftype}{$refname}{Xrefs}{$leaf,$.} =
            "[see <a href=\"$leaf_opath#EnumVal_$valname\">$valname</a>]";
        $sdef{EnumVal}{$valname}{Used} = 1;
        return defn($valname,'EnumVal',$valname, refhref($reftype,$refname));
    }
}

sub out_xrefs ($) {
    my ($linemapfunc) = @_;
    foreach my $xref (@pending_xrefs) {
        $o .= $linemapfunc->($xref);
        $o .= "\n";
    }
    @pending_xrefs = ();
}

sub incontents ($$$) {
    my ($text, $seq, $anchor) = @_;
    $anchor = "incontents_$anchor";
    if ($pass==2) {
        push @incontents, { 
            Seq => $seq,
            Href => "$leaf_opath#$anchor",
            Title => $text,
        };
    }
    return "<a name=\"$anchor\"><strong>$text</strong></a>";
}

sub write_file ($$) {
    my ($opath, $odata) = @_;
    my $out = new IO::File "$opath.new", '>' or die "$opath $!";
    print $out $odata or die $!;
    rename "$opath.new", "$opath" or die "$opath $!";
}

sub process_file ($$) {
    my ($infile, $outfile) = @_;
    debug(1,"$pass $infile => $outfile");
    my $in = new IO::File "$infile", '<' or die "$infile $!";

    $o = '';
    $in_enum = undef;
    @pending_xrefs = ();

    $o .= "<html><head><title>$leaf - $xtitle</title></head><body><pre>\n";
    
    while (<$in>) {
        s/\&/\&amp;/g;
        s/\</\&lt;/g;
        s/\>/\&gt;/g;

        if (m/^(.*\`)[ \t]*$/) {
            my $lhs = $1;
            out_xrefs(sub { "$1 $_[0]"; });
        } elsif (m/^\s*$/) {
            out_xrefs(sub { sprintf "/* %70s */", $_[0]; });
        }

        # In case of comments, strip " /* ` " and " * ` ";
        my $lstripped = s,^ \s* /? \* \s* \` \  ,,x ? $&: '';

        # Strip trailing whitespace and perhaps trailing "*/" or "*"
        s,(?: \s* \* /? )? \s* $,,x or die;
        my $rstripped = $&;

        # Now the actual functionality:

        debug(3,"$. $_");

        if (!m/^(?: __attribute__ | __pragma__ )\b/x &&
            s/^( (?: \w+\  )? ) (\w+[a-z]\w+) ( \( .*)$
             / $1.defn($2,'Func',$2).norm($3) /xe) {
        } elsif (s/^((struct|union|enum) \  (\w+)) ( \s+ \{ .* )$
                  / defn($1,(ucfirst $2),$3).norm($4) /xe) {
            if ($2 eq 'enum') {
                if (m,/[/*] (\w+)\* \=\&gt\; (\w+)\*\(\),) { 
                    in_enum($1,'Func',$2)
                } elsif (m,/[/*] (\w+)\* \=\&gt\; (struct) (\w+)\*,) { 
                    in_enum($1,(ucfirst $2),$3);
                }
            }
        } elsif (s/^(typedef \s+ )((struct|union|enum) \  (\w+))
                      (\s+) (\w+)(\;)$
                  / norm($1).norm($2).$5.
                    defn($6,'Typedef',$6,undef,[(ucfirst $3),$4]).
                    $7 /xe) {
        } elsif (s/^(typedef \s+) (\w+) (\s+) (\w+) (\;)$
                  / $1.norm($2).$3.
                    defn($4,'Typedef',$4,undef,['Typedef',$2]). $5 /xe) {
        } elsif (s/^( \s* \#define \s+ ) (\w+) ( \s+\S )
                  / $1.defmacro($2).norm($3) /xe) {
        } elsif (s/( \`incontents \s+ (\d+) \s+ (\w+) \s+ )(\S .* \S)
                 / norm($1).incontents($4, $2, $3) /xe) {
        } else {
            if (m/^\s*\}/) {
                $in_enum = undef;
            }
            $_ = norm($_);
        }

        # Write the line out

        if ($pass == 2) {
            $o .= $lstripped;
            $o .= $_;
            $o .= $rstripped;
        }
    }

    warning("pending xrefs at end of file") if @pending_xrefs;

    if ($pass == 2) {
        push @outfiles, [ $leaf, $leaf_opath ];
        $o .= "</pre></body></html>";
        write_file($outfile, $o);
    }
}

sub output_index () {
    my $title = "contents - $xtitle";
    $o = '';
    $o .= <<END;
<html><head><title>$title</title></head>
<body>
<h1>$title</h1>
<h2>Starting points</h2>
<ul>
END
    foreach my $ic (sort { $a->{Seq} <=> $b->{Seq} } @incontents) {
        $o .= "<li><a href=\"$ic->{Href}\">$ic->{Title}</a></li>\n";
    }
    $o .= "</ul>\n";
    my $forkind = sub {
        my ($type,$desc,$pfx,$sfx) = @_;
        $o .= "<h2>$desc</h2><ul>\n";
        foreach my $name (sort keys %{ $sdef{$type} }) {
            my $href = refhref($type,$name);
            next unless $href =~ m/\S/;
            $o .= "<li><a $href>$pfx$name$sfx</a></li>\n";
        }
        $o .= "</ul>\n";
    };
    $forkind->('Func','Functions','','()');
    $forkind->('Struct','Structs','struct ','');
    $forkind->('Enum','Enums and sets of #defines','','');
    $forkind->('Typedef','Typedefs','typedef ','');
    $forkind->('EnumVal','Enum values and individual #defines','','');
    $o .= "</ul>\n<h2>Files</h2><ul>\n";
    foreach my $of (sort { $a->[0] cmp $b->[0] } @outfiles) {
        $o .= "<li><a href=\"$of->[1]\">$of->[0]</a></li>\n";
    }
    $o .= "</ul></body></html>\n";
    write_file("$outdir/index.html", $o);
}

foreach $pass (qw(1 2)) {
    my $depspath = "$outdir/.deps";
    my $depsout;
    if ($pass==2) {
        $depsout = new IO::File "$depspath.new", 'w' or die $!;
    }

    find({ wanted => 
               sub {
                   return unless m/\.h$/;
                   stat $File::Find::name or die "$File::Find::name $!";
                   -f _ or die "$File::Find::name";
                   substr($File::Find::name, 0, 1+length $basedir) 
                       eq "$basedir/"
                       or die "$File::Find::name $basedir";
                   $leaf = substr($File::Find::name, 1+length $basedir);
                   if (!file_wanted()) {
                       debug(1,"$pass $File::Find::name excluded");
                       return;
                   }
                   $leaf_opath = $leaf;
                   $leaf_opath =~ s#/#,#g;
                   $leaf_opath .= ".html";
                   print $depsout "$outdir/index.html: $File::Find::name\n"
                       or die $!
                       if $pass==2;
                   process_file($File::Find::name, $outdir.'/'.$leaf_opath);
           },
           no_chdir => 1,
         },
         map { "$basedir/$_" } @indirs);

    if ($pass==2) {
        close $depsout or die $!;
        rename "$depspath.new", "$depspath" or die $!;
    }
}

output_index();