<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
# Generate a table of contents for a docbook document
# tags are case insensitive
# part of doctoc version 2.0

use XML::Parser;
use integer;
use strict;
#use utf8;

package Toc;
# levels:
#       &gt;=0 absolute level
#        -1 additional level relative to current, numbered            
#        -2 additional level relative to current, not numbered,
#           doesn't increase level
#        -3 don't include into toc

# all ellements which can have a title (docbook 3.1)
%Toc::levels = (
           "abstract"           =&gt; -1,
           "appendix"           =&gt; -2,
           "artheader"          =&gt; -3,
           "article"            =&gt;  1,
           "authorblurb"        =&gt; -3,
           "bibliodiv"          =&gt; -3,
           "biblioentry"        =&gt; -3,
           "bibliography"       =&gt; -1,
           "bibliomixed"        =&gt; -3,
           "bibliomset"         =&gt; -3,
           "biblioset"          =&gt; -3,
           "blockquote"         =&gt; -3,
           "book"               =&gt;  0,
           "bookbiblio"         =&gt; -3,
           "bookinfo"           =&gt; -3,
           "calloutlist"        =&gt; -3,
           "caution"            =&gt; -3,
           "chapter"            =&gt;  1,
           "dedication"         =&gt; -1,
           "docinfo"            =&gt; -1,
           "equation"           =&gt; -3,
           "example"            =&gt; -3,
           "figure"             =&gt; -3,
           "formalpara"         =&gt; -2,
           "glossary"           =&gt; -1,
           "glossdiv"           =&gt; -3,
           "important"          =&gt; -1,
           "index"              =&gt; -1,
           "indexdiv"           =&gt; -3,
           "legalnotice"        =&gt; -1,
           "lot"                =&gt; -1,
           "msg"                =&gt; -3,
           "msgexplan"          =&gt; -3,
           "msgmain"            =&gt; -3,
           "msgrel"             =&gt; -3,
           "msgsub"             =&gt; -3,
           "note"               =&gt; -3,
           "para"               =&gt; -2,
           "part"               =&gt;  0,
           "partintro"          =&gt; -1,
           "preface"            =&gt; -1,
           "procedure"          =&gt; -3,
           "reference"          =&gt; -3,
           "refmeta"            =&gt; -3,
           "refsect1"           =&gt;  2,
           "refsect1info"       =&gt; -3,
           "refsect2"           =&gt;  3,
           "refsect2info"       =&gt; -3,
           "refsect3"           =&gt;  4,
           "refsect3info"       =&gt; -3,
           "refsect4"           =&gt;  5,
           "refsect5"           =&gt;  6,
           "refsynopsisdiv"     =&gt; -3,
           "refsynopsisdivinfo" =&gt; -3,
           "sect1"              =&gt;  2,
           "sect1info"          =&gt; -3,
           "sect2"              =&gt;  3,
           "sect2info"          =&gt; -3,
           "sect3"              =&gt;  4,
           "sect3info"          =&gt; -3,
           "sect4"              =&gt;  5,
           "sect4info"          =&gt; -3,
           "sect5"              =&gt;  6,
           "sect5info"          =&gt; -3,
           "section"            =&gt; -1,
           "segmentedlist"      =&gt; -3,
           "seriesinfo"         =&gt; -1,
           "set"                =&gt; -1,
           "setindex"           =&gt; -1,
           "setinfo"            =&gt; -3,
           "sidebar"            =&gt; -3,
           "simplesect"         =&gt; -1,
           "step"               =&gt; -3,
           "table"              =&gt; -3,
           "tip"                =&gt; -3,
           "toc"                =&gt; -1,
           "variablelist"       =&gt; -3,
           "warning"            =&gt; -3,
);

@Toc::secnums = (0) x (max(values %Toc::levels)+1); # section numbers
$Toc::parent = "";		# parent of last &lt;title&gt;
$Toc::parentline_no = 0;	# line no of parent
$Toc::parentbase = "";		# base URL of parent
$Toc::minlevel = 0;		# =0 for book, =1 for article
                                # detected automatically
$Toc::currentlevel = 0;		# level of current $title
$Toc::title = "";		# current &lt;title&gt; or &lt;titleabbrev&gt;
$Toc::extraindent_step = 0;	# additionally indent toc entry 
                                # by this much per level
$Toc::width = 75;		# 3 characters needed for outline minor mode
$Toc::fill_character = ".";	# "·" might be nice in some fonts

# return largest
sub max {
  my $max=shift(@_);
  foreach my $i (@_) {
    $max=$i if $i &gt; $max;
  }
  return $max;
}

# emit an toc entry for $parent, $title
sub tocentry {
  use Text::Wrap;
  my $text         = $Toc::title;
  $Toc::title = "";
  my $parent_level = $Toc::levels{$Toc::parent};
  my $line_no      = $Toc::parentline_no;
  my $base         = $Toc::parentbase;
  my $clevel       = $Toc::currentlevel;
  my $mlevel       = $Toc::minlevel;
  my $extra_indent = max(0,($clevel-$mlevel)*$Toc::extraindent_step);

  # strip tags and superflous whitespace
  $text=~s/&lt;[^&gt;]+&gt;//g;
  $text=~s/\s+/ /g;

  # prepend base URL to line number
  $line_no = "$base :$line_no" unless $base eq "-";

  # generate complete number
  my $num="";
  if($parent_level &gt; -2) {
    # numbered entry
    for (my $i=$mlevel+1; $i&lt;=$clevel; $i++) {
      $num .= $Toc::secnums[$i].".";
    }
    chop($num) if $num;
    $num .= " " x (3*($clevel-$mlevel)-1-length($num));
  } else {
    # unnumbered entry
    $num  = " " x (3*($clevel-$mlevel+1)-1);
  }

  # wrap title
  my $pre1 = " " x $extra_indent.$num." ";
  my $pre2 = " " x length($pre1);
  $Text::Wrap::columns = $Toc::width-1-6; # 6 digits for line number
  $text = wrap($pre1, $pre2, $text);
  $text =~ tr/\t/ /;

  # fill last line with points, $l is bare length of last line
  my $l=length($text)-(rindex($text,"\n")+1);
  my $lp = length($line_no);
  # take possibly long position into account
  my $fill=$Toc::width-$lp-$l;
  if($fill &lt; 0) {
    # needs to be on line by itself
    $fill=$Toc::width-$l-6;
    if($lp &gt; $Toc::width-length($pre2)) {
      # doesn't even fit on a regular line
      $line_no = "\n". $pre2 . $line_no;
    } else {
      # fits
      $line_no = "\n". " " x ($Toc::width-$lp) . $line_no;
    }
  }
  unless($fill &lt; 2) {
    $fill = " ".($Toc::fill_character x ($fill-2))." ";
  } else {
    $fill = " ";
  }

  print "$text$fill$line_no\n";
}

# start tag handlers
sub first_stag {
  my $parser=shift;
  my $tagname=lc(shift);
  if($tagname eq "article") {
    $Toc::minlevel = 1;
    $Toc::currentlevel = $Toc::minlevel;
  }
  $Toc::parent=$tagname if exists($Toc::levels{$tagname});
  $parser-&gt;setHandlers(Start=&gt;\&amp;stag);
}

sub stag {
  my $parser=shift;
  my $tagname=lc(shift);
  my $element_level;

  if($tagname =~ m/\Atitle(abbrev)?\Z/) {
    # switch data collection on
    $Toc::title = "";
    $parser-&gt;setHandlers(Char=&gt;\&amp;cdata) if($Toc::levels{$Toc::parent}&gt;-3);
  } elsif(exists($Toc::levels{$tagname})) {
    &amp;tocentry if $Toc::title; # title was not yet emitted to toc
    $Toc::parent=$tagname;
    $Toc::parentline_no = $parser-&gt;current_line();
    $Toc::parentbase = $parser-&gt;base();
    $element_level=$Toc::levels{$tagname};
    if($element_level&gt;=0) {
      # look for gaps
      while(++$Toc::currentlevel &lt;= $element_level) {
        $Toc::secnums[$Toc::currentlevel] = 0 
	  unless(defined($Toc::secnums[$Toc::currentlevel]));
      }
      # looking for overlap ist not neccessary
      $Toc::currentlevel = $element_level;
      $Toc::secnums[$Toc::currentlevel]++;
    } elsif ($element_level == -1) {
      $Toc::currentlevel ++;
      if(defined($Toc::secnums[$Toc::currentlevel])) {
        $Toc::secnums[$Toc::currentlevel]++;
      } else {
        $Toc::secnums[$Toc::currentlevel] = 1;
      }
    }
    for(my $i=$Toc::currentlevel+1; $i&lt;=$#Toc::secnums; $i++) {
      $Toc::secnums[$i] = 0;
    }
  }
}

# end tag handler
sub etag {
  my $parser=shift;
  my $tagname=lc(shift);
  if($tagname =~ m/\Atitle(abbrev)?\Z/) {
    $parser-&gt;setHandlers(Char=&gt;0);
  } elsif (exists($Toc::levels{$tagname})) {
    &amp;tocentry if $Toc::title; # title was not yet emitted to toc
    $Toc::currentlevel=
      max($Toc::currentlevel-1,0) if ($Toc::levels{$tagname}&gt;=-1);
  }
}

# character data handler
sub cdata {
  $Toc::title .= $_[1];
}

# "main"

my $file = '-';
unshift(@ARGV, $file) unless @ARGV;

  
while(defined($file = shift)) {
  my $parser = new XML::Parser(ErrorContext =&gt; 2);
  $parser-&gt;setHandlers(Start =&gt; \&amp;first_stag,
		       End   =&gt; \&amp;etag);
  $parser-&gt;parsefile($file);
}

</pre></body></html>