hhi

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # hhi
   5 # File ID: 9f049aca-5d3b-11df-8f49-90e6ba3022ac
   6 #
   7 # Html Header Indexer
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2002– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18
  19 local $| = 1;
  20
  21 our %Opt = (
  22
  23     'all' => 0,
  24     'help' => 0,
  25     'no-number' => 0,
  26     'quiet' => 0,
  27     'startlevel' => 2,
  28     'verbose' => 0,
  29     'version' => 0,
  30
  31 );
  32
  33 our $progname = $0;
  34 $progname =~ s/^.*\/(.*?)$/$1/;
  35 our $VERSION = '0.1.0';
  36
  37 Getopt::Long::Configure('bundling');
  38 GetOptions(
  39
  40     'all|a' => \$Opt{'help'},
  41     'help|h' => \$Opt{'help'},
  42     'no-number|n' => \$Opt{'no-number'},
  43     'quiet|q+' => \$Opt{'quiet'},
  44     'startlevel|l=i' => "",
  45     'verbose|v+' => \$Opt{'verbose'},
  46     'version' => \$Opt{'version'},
  47
  48 ) || die("$progname: Option error. Use -h for help.\n");
  49
  50 $Opt{'verbose'} -= $Opt{'quiet'};
  51 $Opt{'help'} && usage(0);
  52 if ($Opt{'version'}) {
  53     print_version();
  54     exit(0);
  55 }
  56
  57 exit(main());
  58
  59 sub main {
  60     # {{{
  61     my $Retval = 0;
  62
  63     my $last_level = 1;
  64     my $start_level = 2;
  65     my @header_num = qw{0};
  66     my @Data = ();
  67     my @Toc = ();
  68     my %name_used = ();
  69
  70     if ($Opt{'startlevel'} =~ /^\d+$/) {
  71         if ($Opt{'startlevel'} < 1) {
  72             die("$progname: Number passed to -l has to be bigger than zero\n");
  73         } else {
  74             $start_level = $Opt{'startlevel'};
  75         }
  76     } else {
  77         die("$progname: -l wants a number\n")
  78     }
  79
  80     while (<>) {
  81         # {{{
  82         my $orig_line = $_;
  83         if (!/ nohhi /i && /^(.*)<(h)(\d+)(.*?)>(.*)$/i) {
  84             # Header found {{{
  85             my ($Pref, $H, $header_level, $Elem, $Rest) = ($1, $2, $3, $4, $5);
  86             if ($header_level >= $start_level) {
  87                 my $skip_num = 0;
  88                 splice(@header_num, $header_level-1)
  89                     if ($header_level < $last_level);
  90                 if ($header_level - $last_level > 1) {
  91                     warn("$progname: Line $.: Header skip " .
  92                         "($last_level to $header_level)\n");
  93                     for (my $Tmp = 0; $Tmp < $header_level-2; $Tmp++) {
  94                         defined($header_num[$Tmp]) || ($header_num[$Tmp] = "");
  95                     }
  96                 }
  97                 $header_num[$header_level-2]++;
  98                 my $tall_str = join(".", @header_num);
  99                 my $name_str = ($Rest =~ /<!-- hhiname (\S+) -->/i)
 100                     ? $1
 101                     : "h-$tall_str";
 102
 103                 if (defined($name_used{$name_str})) {
 104                     warn("$progname: Line $.: \"$name_str\": " .
 105                         "Section name already used\n");
 106                 }
 107                 $name_used{$name_str} = 1;
 108
 109                 if ($Rest =~ m#^(<a (name|id)=".*?">[\d\.]+</a>\s+)(.*?)$#i) {
 110                     $Rest = $3;
 111                 } elsif ($Rest =~ m#^([\d\.]+)\s*(.*?)$#i) {
 112                     $Rest = $2;
 113                 }
 114                 ($tall_str .= ".") if ($header_level == 2);
 115                 if ($Opt{'no-number'} || $Rest =~ /<!-- nohhinum -->/i) {
 116                     $skip_num = 1;
 117                     $_ = "${Pref}<${H}${header_level}${Elem}>$Rest\n";
 118                 } else {
 119                     $_ = "${Pref}<${H}${header_level}${Elem}>" .
 120                         "<a id=\"$name_str\">$tall_str</a> $Rest\n";
 121                 }
 122                 if (!/<!-- nohhitoc -->/i || $Opt{'all'}) {
 123                     push(@Toc, $skip_num ? "<${H}${header_level}${Elem}>$Rest"
 124                                          : "<${H}${header_level}${Elem}>" .
 125                                            "<b><a href=\"#$name_str\">" .
 126                                            "$tall_str</a></b> $Rest");
 127                 }
 128                 $last_level = $header_level;
 129             }
 130             push(@Data, "$_");
 131             # }}}
 132         } elsif (/<!-- hhitoc -->/i) {
 133             # Contents area found, skip everything until a "<!-- /hhitoc
 134             # -->" is found
 135             # {{{
 136             my $Found = 1;
 137             my $line_num = $.;
 138             push(@Data, "$_");
 139             while (<>) {
 140                 if (m#<!-- /hhitoc -->#i) {
 141                     push(@Data, "$_");
 142                     $Found = 0;
 143                     last;
 144                 }
 145             }
 146             $Found && die("$progname: Line $line_num: " .
 147                 "Missing terminating <!-- /hhitoc -->\n");
 148             # }}}
 149         } else {
 150             push(@Data, "$_");
 151         }
 152         # }}}
 153     }
 154
 155     for my $Line (@Data) {
 156         # Send everything to stdout with optional contents inserted {{{
 157         if ($Line =~ /^(\s*)(<!-- hhitoc -->)(.*)$/i) {
 158             my ($Indent, $HT, $End) = ($1, $2, $3);
 159             print("$Line$Indent<ul>\n$Indent<!-- \x7B\x7B\x7B -->\n");
 160             my $Old = 0;
 161             my ($Cnt, $Txt) = (0, "");
 162             my $Ex = "\t";
 163             for (@Toc) {
 164                 # {{{
 165                 if (/<h(\d+).*?>(.*)<\/h\d+>/i) {
 166                     ($Cnt, $Txt) = ($1, $2);
 167                     my $Diff = $Cnt-$Old;
 168                     $Ex = ""; # "\t" x $Cnt; # FIXME: Temporary disabled
 169                                              # until it works
 170                     if ($Old && $Diff > 0) {
 171                         for (my $T = $Diff; $T; $T--) {
 172                             print("$Indent$Ex<ul>\n");
 173                         }
 174                     } elsif ($Old && $Diff < 0) {
 175                         print("$Indent$Ex</li>\n");
 176                         for (my $T = $Diff; $T; $T++) {
 177                             print("$Indent$Ex</ul>\n$Indent$Ex</li>\n");
 178                         }
 179                     } elsif ($Old) {
 180                         print("$Indent$Ex</li>\n");
 181                     }
 182                     print("$Indent$Ex<li><span>$Txt</span>\n");
 183                     $Old = $Cnt;
 184                 }
 185                 # }}}
 186             }
 187             for (; $Cnt > 1; $Cnt--) {
 188                 msg(2, "Cnt = \"$Cnt\"\n");
 189                 print("$Indent$Ex</li>\n");
 190                 ($Cnt == 2) && print("$Indent<!-- \x7D\x7D\x7D -->\n");
 191                 print("$Indent$Ex</ul>\n");
 192             }
 193         } else {
 194             print("$Line");
 195         }
 196         # }}}
 197     }
 198
 199     return $Retval;
 200     # }}}
 201 } # main()
 202
 203 sub print_version {
 204     # Print program version {{{
 205     print("$progname $VERSION\n");
 206     return;
 207     # }}}
 208 } # print_version()
 209
 210 sub usage {
 211     # Send the help message to stdout {{{
 212     my $Retval = shift;
 213
 214     if ($Opt{'verbose'}) {
 215         print("\n");
 216         print_version();
 217     }
 218     print(<<"END");
 219
 220 Usage: $progname [options] [file [files [...]]]
 221
 222 Parses HTML source and creates section numbers in headers and inserts a
 223 table of contents in a defined area. Refer to the POD at the end of the
 224 Perl file for complete info.
 225
 226 Options:
 227
 228   -a, --all
 229     Include all headers in the table of contents, even those marked with
 230     "<!-- nohhitoc -->"
 231   -h, --help
 232     Show this help.
 233   -l, --startlevel
 234     Start indexing at this level number. Default: 2.
 235   -n, --no-number
 236     Don't number headers
 237   -q, --quiet
 238     Be more quiet. Can be repeated to increase silence.
 239   -v, --verbose
 240     Increase level of verbosity. Can be repeated.
 241   --version
 242     Print version information.
 243
 244 END
 245     exit($Retval);
 246     # }}}
 247 } # usage()
 248
 249 sub msg {
 250     # Print a status message to stderr based on verbosity level {{{
 251     my ($verbose_level, $Txt) = @_;
 252
 253     if ($Opt{'verbose'} >= $verbose_level) {
 254         print(STDERR "$progname: $Txt\n");
 255     }
 256     return;
 257     # }}}
 258 } # msg()
 259
 260 __END__
 261
 262 # Plain Old Documentation (POD) {{{
 263
 264 =pod
 265
 266 =head1 NAME
 267
 268 hhi - Html Header Indexer
 269
 270 =head1 SYNOPSIS
 271
 272 hhi [options] [file [files [...]]]
 273
 274 =head1 DESCRIPTION
 275
 276 The hhi(1) command (re)numbers the headers of HTML source and is able to
 277 create a table of contents in a defined area.
 278 Lines containing C<E<lt>!-- nohhi --E<gt>> will be ignored and lines
 279 containg C<E<lt>!-- nohhitoc --E<gt>> will be numbered, but not included
 280 in the index.
 281 An optional table of contents will be included between the lines
 282
 283   <!-- hhitoc -->
 284   <!-- /hhitoc -->
 285
 286 Any text between those two lines will be replaced.
 287
 288 Every header will be have an index number inserted into the beginning of
 289 the header title, e.g.:
 290
 291   <h1>Header of document</h1>
 292     <h2>Table of contents</h2> <!-- nohhi -->
 293     <!-- hhitoc -->
 294     <!-- /hhitoc -->
 295     <h2>Subsection #1</h2>
 296       <h3>Subsubsection #1.1</h3>
 297         <h4>Header excluded from the index</h4> <!-- nohhitoc -->
 298     <h2>Subsection #2</h2>
 299     <h2>Section with specified name</h2> <!-- hhiname secname -->
 300
 301 will be changed to
 302
 303   <h1>Header of document</h1>
 304     <h2>Table of contents</h2> <!-- nohhi -->
 305     <!-- hhitoc -->
 306     <ul>
 307     <li><b><a href="#h-1">1.</a></b> Subsection #1
 308     <ul>
 309     <li><b><a href="#h-1.1">1.1</a></b> Subsubsection #1.1
 310     </li>
 311     </ul>
 312     </li>
 313     <li><b><a href="#h-2">2.</a></b> Subsection #2
 314     </li>
 315     <li><b><a href="#secname">3.</a></b> Section with specified name
 316     </li>
 317     </ul>
 318     <!-- /hhitoc -->
 319     <h2><a id="h-1">1.</a> Subsection #1</h2>
 320       <h3><a id="h-1.1">1.1</a> Subsubsection #1.1</h3>
 321         <h4><a id="h-1.1.1">1.1.1</a> Header excluded from the index</h4> <!-- nohhitoc -->
 322     <h2><a id="h-2">2.</a> Subsection #2</h2>
 323     <h2><a id="secname">3.</a> Section with specified name</h2> <!-- hhiname secname -->
 324
 325 To avoid creation of names like I<1.2..4>, header levels should not be
 326 skipped, do not let a E<lt>h4E<gt> follow a E<lt>h2E<gt> without a
 327 E<lt>h3E<gt> in between.
 328
 329 =head1 OPTIONS
 330
 331 =over 4
 332
 333 =item B<-a>, B<--all>
 334
 335 Include all headers in the contents, even those marked with S<E<lt>!--
 336 nohhitoc --E<gt>>.
 337
 338 =item B<-l x>, B<--startlevel x>
 339
 340 Start indexing at level x.
 341 Default value is 2, leaving E<lt>h1E<gt> headers untouched.
 342
 343 ==item B<-n>, B<--no-number>
 344
 345 Don’t insert section numbers into headers.
 346
 347 =back
 348
 349 =head1 BUGS
 350
 351
 352
 353 =head1 AUTHOR
 354
 355 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 356
 357 =head1 COPYRIGHT
 358
 359 Copyleft ©2002- Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 360 This is free software; see the file F<COPYING> for legalese stuff.
 361
 362 =head1 LICENCE
 363
 364 This program is free software: you can redistribute it and/or modify it
 365 under the terms of the GNU General Public License as published by the
 366 Free Software Foundation, either version 2 of the License, or (at your
 367 option) any later version.
 368
 369 This program is distributed in the hope that it will be useful, but
 370 WITHOUT ANY WARRANTY; without even the implied warranty of
 371 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 372 See the GNU General Public License for more details.
 373
 374 You should have received a copy of the GNU General Public License along
 375 with this program.
 376 If not, see L<http://www.gnu.org/licenses/>.
 377
 378 =head1 SEE ALSO
 379
 380 =cut
 381
 382 # }}}
 383
 384 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :