| 1 | #!@PERL@ -w |
|---|
| 2 | # gen_codestructure_doc - generate code_structure.html from dir_contents files |
|---|
| 3 | # |
|---|
| 4 | # Copyright (C) 2007 Olly Betts |
|---|
| 5 | # |
|---|
| 6 | # This program is free software; you can redistribute it and/or modify |
|---|
| 7 | # it under the terms of the GNU General Public License as published by |
|---|
| 8 | # the Free Software Foundation; either version 2 of the License, or |
|---|
| 9 | # (at your option) any later version. |
|---|
| 10 | # |
|---|
| 11 | # This program is distributed in the hope that it will be useful, |
|---|
| 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
|---|
| 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|---|
| 14 | # GNU General Public License for more details. |
|---|
| 15 | # |
|---|
| 16 | # You should have received a copy of the GNU General Public License |
|---|
| 17 | # along with this program; if not, write to the Free Software |
|---|
| 18 | # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
|---|
| 19 | |
|---|
| 20 | use strict; |
|---|
| 21 | use POSIX; |
|---|
| 22 | |
|---|
| 23 | if (scalar @ARGV < 2) { |
|---|
| 24 | die "usage: gen_codestructure_doc <output> <root input> [<input>...]\n"; |
|---|
| 25 | } |
|---|
| 26 | |
|---|
| 27 | my $output = shift @ARGV; |
|---|
| 28 | my $version = html_escape("@PACKAGE_STRING@"); |
|---|
| 29 | |
|---|
| 30 | my %desc = (); |
|---|
| 31 | my $rootdir = $ARGV[0]; |
|---|
| 32 | $rootdir =~ s![^/]+$!!; |
|---|
| 33 | for my $dir_contents (@ARGV) { |
|---|
| 34 | open DIR_CONTENTS, "<$dir_contents" or die "$dir_contents: $!\n"; |
|---|
| 35 | local $/ = undef; |
|---|
| 36 | my $xml = <DIR_CONTENTS>; |
|---|
| 37 | close DIR_CONTENTS; |
|---|
| 38 | |
|---|
| 39 | my ($xmldir) = ($xml =~ m!<Directory>\s*(\S+)\s*</Directory>!); |
|---|
| 40 | if (!defined $xmldir) { |
|---|
| 41 | die "$dir_contents: No valid <Directory> tag found\n"; |
|---|
| 42 | } |
|---|
| 43 | if ($xmldir eq "ROOT") { |
|---|
| 44 | $xmldir = ""; |
|---|
| 45 | } |
|---|
| 46 | my $dir = $dir_contents; |
|---|
| 47 | unless ($dir =~ s!^\Q$rootdir\E!!) { |
|---|
| 48 | die "$dir_contents: not under `$rootdir'.\n"; |
|---|
| 49 | } |
|---|
| 50 | $dir =~ s![^/]+$!!; |
|---|
| 51 | $dir =~ s!/$!!; |
|---|
| 52 | if ($dir ne $xmldir) { |
|---|
| 53 | die "$dir_contents: File is in `$dir', but <Directory> says `$xmldir'\n"; |
|---|
| 54 | } |
|---|
| 55 | my ($desc) = ($xml =~ m!<Description>\s*(.*?)\s*</Description>!s); |
|---|
| 56 | if (!defined $desc) { |
|---|
| 57 | die "$dir_contents: No valid <Description> tag found\n"; |
|---|
| 58 | } |
|---|
| 59 | $desc{$dir} = $desc; |
|---|
| 60 | } |
|---|
| 61 | |
|---|
| 62 | my $output_tmp = $output . "T"; |
|---|
| 63 | open OUTPUT, ">$output_tmp" or die "$output_tmp: $!\n"; |
|---|
| 64 | |
|---|
| 65 | print OUTPUT <<EOF; |
|---|
| 66 | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> |
|---|
| 67 | <!-- automatically generated from $version source code --> |
|---|
| 68 | <html> |
|---|
| 69 | <head> |
|---|
| 70 | <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> |
|---|
| 71 | <title>Xapian: Code structure</title> |
|---|
| 72 | </head> |
|---|
| 73 | <body bgcolor="white" text="black"> |
|---|
| 74 | <h1>Index</h1> |
|---|
| 75 | EOF |
|---|
| 76 | |
|---|
| 77 | my $depth = -1; |
|---|
| 78 | for my $dir (sort keys(%desc)) { |
|---|
| 79 | my $tmp = $dir; |
|---|
| 80 | my $d = $tmp =~ s!/!!g; |
|---|
| 81 | if ($d <= $depth) { |
|---|
| 82 | print OUTPUT "</ul>\n" x ($depth - $d); |
|---|
| 83 | } else { |
|---|
| 84 | print OUTPUT "<ul>\n" x ($d - $depth); |
|---|
| 85 | } |
|---|
| 86 | $depth = $d; |
|---|
| 87 | if ($dir eq "") { |
|---|
| 88 | $dir = "ROOT"; |
|---|
| 89 | } |
|---|
| 90 | my $id = $dir; |
|---|
| 91 | $id =~ s!_!__!g; |
|---|
| 92 | $id =~ s!/+!_!g; |
|---|
| 93 | print OUTPUT "<li><a href=\"#$id\">$dir</a>\n"; |
|---|
| 94 | } |
|---|
| 95 | if ($depth >= 0) { |
|---|
| 96 | print OUTPUT "</ul>\n" x ($depth + 1); |
|---|
| 97 | } |
|---|
| 98 | print OUTPUT "<hr>\n"; |
|---|
| 99 | |
|---|
| 100 | print OUTPUT "<h1>Directory structure</h1>\n"; |
|---|
| 101 | |
|---|
| 102 | foreach my $dir (sort keys(%desc)) { |
|---|
| 103 | my $desc = $desc{$dir}; |
|---|
| 104 | my $tmp = $dir; |
|---|
| 105 | my $d = $tmp =~ s!/!!g; |
|---|
| 106 | $d += 2; |
|---|
| 107 | if ($d > 6) { |
|---|
| 108 | $d = 6; |
|---|
| 109 | } |
|---|
| 110 | my $url = "http://trac.xapian.org/browser/tags/@VERSION@/xapian-core/$dir"; |
|---|
| 111 | if ($dir eq "") { |
|---|
| 112 | $dir = "ROOT"; |
|---|
| 113 | } else { |
|---|
| 114 | $url .= "/"; |
|---|
| 115 | } |
|---|
| 116 | my $id = $dir; |
|---|
| 117 | $id =~ s!_!__!g; |
|---|
| 118 | $id =~ s!/+!_!g; |
|---|
| 119 | print OUTPUT "<div id=\"$id\">\n"; |
|---|
| 120 | print OUTPUT "<h$d><a href=\"$url\">$dir</a></h$d>\n"; |
|---|
| 121 | print OUTPUT "<p>", html_escape($desc), "</p>\n"; |
|---|
| 122 | print OUTPUT "</div>\n\n"; |
|---|
| 123 | } |
|---|
| 124 | |
|---|
| 125 | my $date = POSIX::strftime("%Y-%m-%d", gmtime()); |
|---|
| 126 | |
|---|
| 127 | print OUTPUT <<EOF; |
|---|
| 128 | <hr> |
|---|
| 129 | <address> |
|---|
| 130 | Generated for $version on $date by gen_codestructure_doc. |
|---|
| 131 | </address> |
|---|
| 132 | </body> |
|---|
| 133 | </html> |
|---|
| 134 | EOF |
|---|
| 135 | |
|---|
| 136 | unless (close OUTPUT) { |
|---|
| 137 | my $bang = $!; |
|---|
| 138 | unlink $output_tmp; |
|---|
| 139 | die "$output_tmp: $bang\n"; |
|---|
| 140 | } |
|---|
| 141 | rename $output_tmp, $output or die "$output: $!\n"; |
|---|
| 142 | |
|---|
| 143 | sub html_escape { |
|---|
| 144 | my $s = shift; |
|---|
| 145 | $s =~ s/&/&/g; |
|---|
| 146 | $s =~ s/</</g; |
|---|
| 147 | $s =~ s/>/>/g; |
|---|
| 148 | $s =~ s/\n\n/\n\n<p>/g; |
|---|
| 149 | return $s; |
|---|
| 150 | } |
|---|
