| 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"; |