1#!/usr/bin/env perl
2
3#
4# Generate indexes for html documentation
5#
6
7use strict;
8use warnings;
9
10use Getopt::Long;
11use IO::File;
12use File::Basename;
13
14Getopt::Long::Configure('bundling');
15
16@ARGV >= 2 or die;
17
18our @docs;
19our @dirs;
20our %index;
21
22our $outdir;
23our $debug;
24
25GetOptions("i=s" => sub { read_index(@_);},
26           "D" => \$debug)
27    or die;
28
29($outdir,@docs) = @ARGV;
30
31sub write_file ($$) {
32    my ($opath, $odata) = @_;
33    print STDOUT "Writing: $opath\n";
34    my $out = new IO::File "$opath.new", '>' or die "$opath $!";
35    print $out $odata or die $!;
36    rename "$opath.new", "$opath" or die "$opath $!";
37}
38
39sub make_page ($$$) {
40    my ($file,$title,$content) = @_;
41    my $o = '';
42    my $h1;
43    if ( $title eq "" )
44    {
45        $title = $h1 = "Xen Documentation";
46    }
47    else
48    {
49        $h1 = "<a href=\"../index.html\">Xen Documentation</a> - $title";
50        $title = "Xen Documentation - $title";
51    }
52    $o .= <<END;
53<html><head><title>$title</title></head>
54<body>
55<h1>$h1</h1>
56<ul>
57$content
58</ul>
59</body></html>
60END
61    write_file($file, $o);
62}
63
64sub make_linktext ($) {
65    my ($l) = @_;
66    return "$1($2)" if $l =~ m,^man/(.*)\.([0-9].*)\.html,;
67    $l =~ s/.(?:html|txt)$//g;
68    return $index{$l} if exists $index{$l};
69
70    my $from_html;
71    eval {
72        require HTML::TreeBuilder::XPath;
73        my $tree = new HTML::TreeBuilder::XPath;
74        my $f = "$outdir/$l.html";
75        open F, '<', $f or die "$l $f $!";
76        $tree->parse_file(\*F) or die;
77        close F;
78        $from_html = $tree->findvalue("/html/head/title");
79    };
80    print "$l: get title: $@" if $@ && $debug;
81    return $from_html if $from_html;
82
83    return basename($l);
84}
85
86sub make_link ($$) {
87    my ($ref,$base) = @_;
88
89    my $txt = make_linktext($ref);
90    $ref =~ s,^$base/,, if $base; #/
91
92    return "<li><a href=\"$ref\">$txt</a></li>\n";
93}
94
95sub make_links ($@) {
96    my ($dir,@docs) = @_;
97    my $idx = '';
98    foreach my $of (sort { make_linktext($a) cmp make_linktext($b) } @docs) {
99        $idx .= make_link($of,$dir);
100    }
101    return $idx;
102}
103
104sub read_index ($$) {
105    my ($opt, $val) = @_;
106    my $idx = new IO::File "$val", '<' or die "$val $!";
107    while ($_ = $idx->getline()) {
108	s/^\s+//;
109	s/\s+$//;
110	next if m/^\#/;
111	next unless m/\S/;
112	m/^(\S+)\s+(\S.*)$/ or die;
113        $index{$1} = $2;
114    }
115}
116
117sub uniq (@) {
118    my %h;
119    foreach (@_) { $h{$_} = 1; }
120    return keys %h;
121}
122
123for (@docs) { s,^\Q$outdir\E/,, }
124
125@docs = grep { -e "$outdir/$_" && (make_linktext($_) ne "NO-INDEX") } @docs;
126
127my $top = '';
128
129# Return a list of all directories leading to $path
130sub dirs($)
131{
132    my ($path) = @_;
133    my @dirs;
134    while ( $path =~ m,/, )
135    {
136	$path =~ m,/([^/]+)$,;
137	push @dirs, $`;#`
138	$path = $`;#`
139    }
140    return @dirs;
141}
142
143foreach my $of (grep { !m{/} } @docs) {
144    $top .= make_link($of,'');
145}
146
147foreach my $od (sort { $a cmp $b } uniq map { dirs($_) } @docs) {
148    my @d = (grep /^\Q$od\E/, @docs);
149    if ( @d == 1 and $d[0] eq "$od/index.html" )
150    {
151        next if $d[0] =~ m,/,;#/ linked to from the subdirectory entry.
152        $top .= make_link("$od/index.html", 0);
153    }
154    else
155    {
156	my $links = make_links(undef,@d);
157	my $secttitle = make_linktext($od);
158	$top .= <<END;
159<li><a href=\"${od}/index.html\">$secttitle</a></li>
160<ul>
161$links
162</ul>
163END
164
165	$links = make_links($od,@d);
166	my $idx = '';
167	$idx .= <<END;
168<li>$secttitle</li>
169<ul>
170$links
171</ul>
172END
173        make_page("$outdir/$od/index.html", $secttitle, $idx);
174    }
175}
176
177make_page("$outdir/index.html", "", $top);
178