Commit | Line | Data |
---|---|---|
805e021f CE |
1 | #!/usr/bin/perl -w |
2 | package OpenAFS::HTML; | |
3 | ||
4 | use strict; | |
5 | use vars qw(@ISA); | |
6 | ||
7 | use Pod::Simple::Search; | |
8 | @ISA = qw(Pod::Simple::HTML); | |
9 | ||
10 | # Add a link back to the index page to the top and bottom of each generated | |
11 | # page. | |
12 | # | |
13 | # The hideous approach we have to use is because, unless we create a | |
14 | # Pod::Simple::HTML object and then rebless it, the html_header_after_title | |
15 | # and html_footer subs are placed in the OpenAFS::HTML package. That means we | |
16 | # can't override them in a subclass and still call the SUPER version since | |
17 | # we'll be overwriting the SUPER version, and there aren't other good | |
18 | # opportunities to change the default values that I can see. | |
19 | sub new { | |
20 | my $class = shift; | |
21 | my $self = Pod::Simple::HTML->new (@_); | |
22 | bless ($self, 'OpenAFS::HTML'); | |
23 | my $link = '<p class="indexlink"><a href="../index.html">' | |
24 | . 'Back to Index</a></p>' . "\n"; | |
25 | my $after = $self->html_header_after_title; | |
26 | $self->html_header_after_title ($after . $link); | |
27 | my $end = $self->html_footer; | |
28 | $self->html_footer ($link . $end); | |
29 | return $self; | |
30 | } | |
31 | ||
32 | sub do_man_link { | |
33 | my ($self, $token) = @_; | |
34 | my $page = $token->attr ('to'); | |
35 | my ($name, $section) = ($page =~ /^([^\(]+)\((\d+)\)$/); | |
36 | return unless $name; | |
37 | my @url = ('..', $section, $name); | |
38 | return join ('/', map { $self->pagepath_url_escape ($_) } @url) | |
39 | . $Pod::Simple::HTML::HTML_EXTENSION; | |
40 | } | |
41 | ||
42 | # Underscore isn't allowed in man page names in Pod::Simple 3.04, so links | |
43 | # like L<fs_setacl(8)> show up as POD links. Discover that case and dispatch | |
44 | # everything else to the standard do_pod_link implementation. | |
45 | sub do_pod_link { | |
46 | my ($self, $token) = @_; | |
47 | my $target = $token->attr ('to'); | |
48 | if ($target && $target =~ /^([^\s\(]+)\((\d+)\)$/) { | |
49 | return $self->do_man_link ($token); | |
50 | } else { | |
51 | return $self->SUPER::do_pod_link ($token); | |
52 | } | |
53 | } | |
54 | ||
55 | sub VERSION () { '1.1' } | |
56 | ||
57 | $Pod::Simple::HTML::Tagmap{'item-bullet'} = '<li><p>'; | |
58 | $Pod::Simple::HTML::Tagmap{'/item-bullet'} = '</p></li>'; | |
59 | $Pod::Simple::HTML::Tagmap{'item-number'} = '<li><p>'; | |
60 | $Pod::Simple::HTML::Tagmap{'/item-number'} = '</p></li>'; | |
61 | ||
62 | # This horrific hack is required because Pod::Simple::HTMLBatch has no way | |
63 | # of setting search options and we have to set laborious to true in order | |
64 | # to pick up man pages like krb.conf(5). | |
65 | package OpenAFS::Search; | |
66 | ||
67 | use strict; | |
68 | use vars qw(@ISA); | |
69 | ||
70 | use Pod::Simple::Search; | |
71 | @ISA = qw(Pod::Simple::HTML); | |
72 | ||
73 | sub new { | |
74 | my $class = shift; | |
75 | my $object = Pod::Simple::Search->new; | |
76 | $object->laborious (1); | |
77 | return $object; | |
78 | } | |
79 | ||
80 | package main; | |
81 | ||
82 | use strict; | |
83 | ||
84 | use File::Copy; | |
85 | use Pod::Simple::HTMLBatch; | |
86 | ||
87 | # Override the search class to set laborious. | |
88 | $Pod::Simple::HTMLBatch::SEARCH_CLASS = 'OpenAFS::Search'; | |
89 | ||
90 | our $HEADER = <<'EOH'; | |
91 | <html> | |
92 | <head> | |
93 | <title>OpenAFS Reference Manual</title> | |
94 | <link rel="stylesheet" title="style" type="text/css" href="style.css" media="all"> | |
95 | </head> | |
96 | <body class='contentspage'> | |
97 | <h1>OpenAFS Reference Manual</h1> | |
98 | EOH | |
99 | ||
100 | our %HEADINGS = (1 => 'User Commands', | |
101 | 3 => 'C Library Functions', | |
102 | 5 => 'Configuration and Data Files', | |
103 | 8 => 'Administrator Commands'); | |
104 | ||
105 | # Scan all of the POD files and build a list of section, name, and short | |
106 | # description, returning that as an array. | |
107 | sub scan_names { | |
108 | my @index; | |
109 | for my $dir (qw(pod1 pod3 pod5 pod8)) { | |
110 | my $section = $dir; | |
111 | $section =~ s/^pod//; | |
112 | opendir (D, $dir) or die "Cannot open $dir: $!\n"; | |
113 | for my $file (sort grep { !/^\./ && /\.pod$/ } readdir D) { | |
114 | open (F, "$dir/$file") or die "Cannot open $dir/$file: $!\n"; | |
115 | my ($name, $desc); | |
116 | local $_; | |
117 | while (<F>) { | |
118 | last if /^=head1/ && !/^=head1\s+NAME\b/; | |
119 | next unless /\s+-\s+/; | |
120 | ($name, $desc) = split (/\s+-\s+/, $_, 2); | |
121 | } | |
122 | unless ($name) { | |
123 | warn "$dir/$file: cannot find NAME section, skipping\n"; | |
124 | } | |
125 | $name =~ s/^(backup|bos|fs|fstrace|kas|pts|symlink|uss|vos)_/$1 /; | |
126 | if ($section eq '3') { | |
127 | $name =~ s/^AFS\./AFS::/; | |
128 | } | |
129 | if ($section eq '5') { | |
130 | $name =~ s/_/ /g; | |
131 | } | |
132 | my $page = $file; | |
133 | $page =~ s/\.pod$//; | |
134 | push (@index, [ $section, $name, $page, $desc ]); | |
135 | } | |
136 | closedir D; | |
137 | } | |
138 | return @index; | |
139 | } | |
140 | ||
141 | unless (-d 'html') { | |
142 | mkdir ('html', 0755) or die "Cannot create html directory: $!\n"; | |
143 | } | |
144 | for my $dir (qw(pod1 pod3 pod5 pod8)) { | |
145 | my $section = $dir; | |
146 | $section =~ s/^pod//; | |
147 | mkdir ("html/$section", 0755) unless -d "html/$section"; | |
148 | ||
149 | my $conv = Pod::Simple::HTMLBatch->new; | |
150 | $conv->verbose (0); | |
151 | $conv->index (undef); | |
152 | $conv->contents_file (undef); | |
153 | $conv->add_css ('../style.css', 1); | |
154 | $conv->css_flurry (0); | |
155 | $conv->javascript_flurry (0); | |
156 | $conv->html_render_class ('OpenAFS::HTML'); | |
157 | $conv->batch_convert ($dir, "html/$section"); | |
158 | } | |
159 | copy ('style.css', 'html/style.css') or die "Cannot copy style.css: $!\n"; | |
160 | ||
161 | open (INDEX, '> html/index.html') | |
162 | or die "Cannot create html/index.html: $!\n"; | |
163 | print INDEX $HEADER; | |
164 | print INDEX "<table>\n"; | |
165 | my @index = scan_names; | |
166 | my $current; | |
167 | for my $entry (@index) { | |
168 | my ($section, $name, $page, $desc) = @$entry; | |
169 | for ($name, $desc) { | |
170 | s/&/>/g; | |
171 | s/</</g; | |
172 | s/>/>/g; | |
173 | } | |
174 | if (!$current || $section != $current) { | |
175 | print INDEX qq(<tr><td> </td></tr>\n); | |
176 | print INDEX qq(<tr class="heading"><th colspan="2">); | |
177 | print INDEX qq($HEADINGS{$section}</th></tr>\n); | |
178 | $current = $section; | |
179 | } | |
180 | print INDEX qq(<tr><td><a href="$section/$page.html">$name</a></td>); | |
181 | print INDEX qq(<td>$desc</td></tr>\n); | |
182 | } | |
183 | print INDEX "</table>\n</body>\n</html>\n"; |