Bring Pod::Simple up to 3.09 as on CPAN.

8 files changed, 342 insertions, 83 deletions

diff --git a/cpan/Pod-Simple/lib/Pod/Simple.pm b/cpan/Pod-Simple/lib/Pod/Simple.pm
index 1089099d0d..a122bf700b 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple.pm
@@ -5,7 +5,7 @@ use strict;
 use Carp ();
 BEGIN           { *DEBUG = sub () {0} unless defined &DEBUG }
 use integer;
-use Pod::Escapes 1.03 ();
+use Pod::Escapes 1.04 ();
 use Pod::Simple::LinkSection ();
 use Pod::Simple::BlackBox ();
 #use utf8;
@@ -18,7 +18,7 @@ use vars qw(
 );
 
 @ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 @Known_formatting_codes = qw(I B C L E F S X Z); 
 %Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
@@ -67,7 +67,7 @@ __PACKAGE__->_accessorize(
 
   'hide_line_numbers', # For some dumping subclasses: whether to pointedly
                        # suppress the start_line attribute
-                      
+
   'line_count',        # the current line number
   'pod_para_count',    # count of pod paragraphs seen so far
 
@@ -87,6 +87,7 @@ __PACKAGE__->_accessorize(
                        #  text up into several events
 
   'preserve_whitespace', # whether to try to keep whitespace as-is
+  'strip_verbatim_indent', # What indent to strip from verbatim
 
  'content_seen',      # whether we've seen any real Pod content
  'errors_seen',       # TODO: document.  whether we've seen any errors (fatal or not)
@@ -98,7 +99,7 @@ __PACKAGE__->_accessorize(
  #Called like:
  # $code_handler->($line, $self->{'line_count'}, $self) if $code_handler;
  #  $cut_handler->($line, $self->{'line_count'}, $self) if $cut_handler;
-  
+
 );
 
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
diff --git a/cpan/Pod-Simple/lib/Pod/Simple.pod b/cpan/Pod-Simple/lib/Pod/Simple.pod
index a58217336a..b9e13a688c 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple.pod
+++ b/cpan/Pod-Simple/lib/Pod/Simple.pod
@@ -151,10 +151,7 @@ If you set this attribute to a true value, it will send reports of
 parsing errors to STDERR. By default, this attribute's value is false,
 meaning that no output is sent to STDERR.
 
-Note that errors can be noted in an errata section, or sent to STDERR,
-or both, or neither. So don't think that turning on C<complain_stderr>
-will turn off C<no_errata_section> or vice versa -- these are
-independent attributes.
+Setting C<complain_stderr> also sets C<no_errata_section>.
 
 
 =item C<< $parser->source_filename >>
@@ -173,8 +170,51 @@ Pod content in it.
 This returns true if C<$parser> has read from a source, and come to the
 end of that source.
 
-=back
+=item C<< $parser->strip_verbatim_indent( I<SOMEVALUE> ) >>
+
+The perlpod spec for a Verbatim paragraph is "It should be reproduced
+exactly...", which means that the whitespace you've used to indent your
+verbatim blocks will be preserved in the output. This can be annoying for
+outputs such as HTML, where that whitespace will remain in front of every
+line. It's an unfortunate case where syntax is turned into semantics.
+
+If the POD your parsing adheres to a consistent indentation policy, you can
+have such indentation stripped from the beginning of every line of your
+verbatim blocks. This method tells Pod::Simple what to strip. For two-space
+indents, you'd use:
+
+  $parser->strip_verbatim_indent('  ');
+
+For tab indents, you'd use a tab character:
+
+  $parser->strip_verbatim_indent("\t");
 
+If the POD is inconsistent about the indentation of verbatim blocks, but you
+have figured out a heuristic to determine how much a particular verbatim block
+is indented, you can pass a code reference instead. The code reference will be
+executed with one argument, an array reference of all the lines in the
+verbatim block, and should return the value to be stripped from each line. For
+example, if you decide that you're fine to use the first line of the verbatim
+block to set the standard for indentation of the rest of the block, you can
+look at the first line and return the appropriate value, like so:
+
+  $new->strip_verbatim_indent(sub {
+      my $lines = shift;
+      (my $indent = $lines->[0]) =~ s/\S.*//;
+      return $indent;
+  });
+
+If you'd rather treat each line individually, you can do that, too, by just
+transforming them in-place in the code reference and returning C<undef>. Say
+that you don't want I<any> lines indented. You can do something like this:
+
+  $new->strip_verbatim_indent(sub {
+      my $lines = shift;
+      sub { s/^\s+// for @{ $lines },
+      return undef;
+  });
+
+=back
 
 =head1 CAVEATS
 
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm
index 4804973a2e..65438dfd4c 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm
@@ -22,6 +22,7 @@ package Pod::Simple::BlackBox;
 use integer; # vroom!
 use strict;
 use Carp ();
+#use constant DEBUG => 7;
 BEGIN {
   require Pod::Simple;
   *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
@@ -1369,8 +1370,19 @@ sub _ponder_Verbatim {
   DEBUG and print " giving verbatim treatment...\n";
 
   $para->[1]{'xml:space'} = 'preserve';
+
+  my $indent = $self->strip_verbatim_indent;
+  if ($indent && ref $indent eq 'CODE') {
+      my @shifted = (shift @{$para}, shift @{$para});
+      $indent = $indent->($para);
+      unshift @{$para}, @shifted;
+  }
+
   for(my $i = 2; $i < @$para; $i++) {
     foreach my $line ($para->[$i]) { # just for aliasing
+      # Strip indentation.
+      $line =~ s/^\E$indent// if $indent
+          && !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted});
       while( $line =~
         # Sort of adapted from Text::Tabs -- yes, it's hardwired in that
         # tabs are at every EIGHTH column.  For portability, it has to be
@@ -1689,15 +1701,30 @@ sub _treelet_from_formatting_codes {
     if(defined $1) {
       if(defined $2) {
         DEBUG > 3 and print "Found complex start-text code \"$1\"\n";
-        push @stack, length($2) + 1; 
-          # length of the necessary complex end-code string
+        # signal that we're looking for simple unless we're in complex.
+        if ($stack[-1]) {
+            # We're in complex already. It's just stuff.
+            DEBUG > 4 and print " It's just stuff.\n";
+            push @{ $lineage[-1] }, $1;
+        } else {
+            # length of the necessary complex end-code string
+            push @stack, length($2) + 1;
+            push @lineage, [ substr($1,0,1), {}, ];  # new node object
+            push @{ $lineage[-2] }, $lineage[-1];
+        }
       } else {
         DEBUG > 3 and print "Found simple start-text code \"$1\"\n";
-        push @stack, 0;  # signal that we're looking for simple
+        if ($stack[-1]) {
+            # We're in complex already. It's just stuff.
+            DEBUG > 4 and print " It's just stuff.\n";
+            push @{ $lineage[-1] }, $1;
+        } else {
+            # signal that we're looking for simple.
+            push @stack, 0;
+            push @lineage, [ substr($1,0,1), {}, ];  # new node object
+            push @{ $lineage[-2] }, $lineage[-1];
+        }
       }
-      push @lineage, [ substr($1,0,1), {}, ];  # new node object
-      push @{ $lineage[-2] }, $lineage[-1];
-      
     } elsif(defined $4) {
       DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n";
       # This is where it gets messy...
@@ -1733,7 +1760,7 @@ sub _treelet_from_formatting_codes {
       pop @lineage;
       
     } elsif(defined $5) {
-      DEBUG > 3 and print "Found apparent simple end-text code \"$4\"\n";
+      DEBUG > 3 and print "Found apparent simple end-text code \"$5\"\n";
 
       if(@stack and ! $stack[-1]) {
         # We're indeed expecting a simple end-code
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm
index b00e58daba..7747f0bea8 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm
@@ -130,7 +130,7 @@ is basically equivalent to this:
 L<Pod::Simple>
 
 The article "Constants in Perl", in I<The Perl Journal> issue
-21.  See L<http://www.sysadminmag.com/tpj/issues/vol5_5/>
+21.  See L<http://interglacial.com/tpj/21/>
 
 =head1 COPYRIGHT AND DISCLAIMERS
 
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm
index a4dbbc17d0..44c555546c 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm
@@ -512,7 +512,7 @@ sub _do_middle_main_loop {
         $stack[-1] = $tagmap->{"/$tagname"};
         if( $tagname eq 'item-text' and defined(my $next = $self->get_token) ) {
           $self->unget_token($next);
-          if( $next->type eq 'start' and $next->tagname !~ m/^item-/s ) {
+          if( $next->type eq 'start' ) {
             print $fh $tagmap->{"/item-text"},$tagmap->{"item-body"};
             $stack[-1] = $tagmap->{"/item-body"};
           }
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm
index cb26cabf37..96093fbd6d 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm
@@ -37,6 +37,7 @@ $HTML_RENDER_CLASS ||= "Pod::Simple::HTML";
 Pod::Simple::_accessorize( __PACKAGE__,
  'verbose', # how verbose to be during batch conversion
  'html_render_class', # what class to use to render
+ 'search_class', # what to use to search for POD documents
  'contents_file', # If set, should be the name of a file (in current directory)
                   # to write the list of all modules to
  'index', # will set $htmlpage->index(...) to this (true or false)
@@ -71,6 +72,7 @@ sub go {
 sub new {
   my $new = bless {}, ref($_[0]) || $_[0];
   $new->html_render_class($HTML_RENDER_CLASS);
+  $new->search_class($SEARCH_CLASS);
   $new->verbose(1 + DEBUG);
   $new->_contents([]);
   
@@ -246,11 +248,8 @@ sub _do_one_batch_conversion {
   }
 
   # Give each class a chance to init the converter:
-  
   $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
    if $page->can('batch_mode_page_object_init');
-  $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
-   if $self->can('batch_mode_page_object_init');
     
   # Now get busy...
   $self->makepath($outdir => \@namelets);
@@ -532,7 +531,7 @@ sub modnames2paths { # return a hashref mapping modulenames => paths
 
   my $m2p;
   {
-    my $search = $SEARCH_CLASS->new;
+    my $search = $self->search_class->new;
     DEBUG and print "Searching via $search\n";
     $search->verbose(1) if DEBUG > 10;
     $search->progress( $self->progress->copy->goal(0) ) if $self->progress;
@@ -681,20 +680,16 @@ sub _gen_css_wad {
    #  010=white_with_green_on_black
    #  011=white_with_blue_on_black
    #  100=white_with_red_on_black
-  
-   qw[
-    110n=black_with_blue_on_white
-    010n=black_with_magenta_on_white
-    100n=black_with_cyan_on_white
-
-    101=white_with_purple_on_black
-    001=white_with_navy_blue_on_black
-
-    010a=grey_with_green_on_black
-    010b=white_with_green_on_grey
-    101an=black_with_green_on_grey
-    101bn=grey_with_green_on_white
-  ]) {
+    '110n=blkbluw',  # black_with_blue_on_white
+    '010n=blkmagw',  # black_with_magenta_on_white
+    '100n=blkcynw',  # black_with_cyan_on_white
+    '101=whtprpk',   # white_with_purple_on_black
+    '001=whtnavk',   # white_with_navy_blue_on_black
+    '010a=grygrnk',  # grey_with_green_on_black
+    '010b=whtgrng',  # white_with_green_on_grey
+    '101an=blkgrng', # black_with_green_on_grey
+    '101bn=grygrnw', # grey_with_green_on_white
+  ) {
 
     my $outname = $variation;
     my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3)
@@ -724,11 +719,13 @@ sub _gen_css_wad {
   }
 
   # Now a few indexless variations:
-  foreach my $variation (qw[
-    black_with_blue_on_white  white_with_purple_on_black
-    white_with_green_on_grey  grey_with_green_on_white
-  ]) {
-    my $outname = "indexless_$variation";
+  foreach my $variation (
+      'blkbluw', # black_with_blue_on_white
+      'whtpurk', # white_with_purple_on_black
+      'whtgrng', # white_with_green_on_grey
+      'grygrnw', # grey_with_green_on_white
+  ) {
+    my $outname = "$variation\_";
     my $this_css = join "\n",
       "/* This file is autogenerated.  Do not edit.  $outname */\n",
       "\@import url(\"./_$variation.css\");",
@@ -737,7 +734,7 @@ sub _gen_css_wad {
     ;
     my $name = $outname;    
     $name =~ tr/-_/  /;
-    $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
+    $self->add_css( "$outname.css", 0, $name, 0, 0, \$this_css);
   }
 
   return;
@@ -1275,6 +1272,14 @@ TODO
 =item $batchconv->html_render_class( I<classname> );
 
 This sets what class is used for rendering the files.
+The default is "Pod::Simple::HTML".  If you set it to something else,
+it should probably be a subclass of Pod::Simple::HTML, and you should
+C<require> or C<use> that class so that's it's loaded before
+Pod::Simple::HTMLBatch tries loading it.
+
+=item $batchconv->search_class( I<classname> );
+
+This sets what class is used for searching for the files.
 The default is "Pod::Simple::Search".  If you set it to something else,
 it should probably be a subclass of Pod::Simple::Search, and you should
 C<require> or C<use> that class so that's it's loaded before
@@ -1300,6 +1305,8 @@ TODO
     $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
   or maybe override
     $batchconv->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
+  subclass Pod::Simple::Search and set $batchconv->search_class to
+    that classname
 
 
 
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm
index 15d973134c..1a6a471003 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm
@@ -319,6 +319,7 @@ sub _get_titled_section {
   my $desperate_for_title  = delete $options{'desperate'};
   my $accept_verbatim      = delete $options{'accept_verbatim'};
   my $max_content_length   = delete $options{'max_content_length'};
+  my $nocase               = delete $options{'nocase'};
   $max_content_length = 120 unless defined $max_content_length;
 
   Carp::croak( "Unknown " . ((1 == keys %options) ? "option: " : "options: ")
@@ -366,6 +367,7 @@ sub _get_titled_section {
         $head1_text_content .= $token->text;
       } elsif( $token->is_end and $token->tagname eq 'head1' ) {
         DEBUG and print "  Found end of head1.  Considering content...\n";
+        $head1_text_content = uc $head1_text_content if $nocase;
         if($head1_text_content eq $titlename
           or $head1_text_content =~ m/\($titlename_re\)/s
           # We accept "=head1 Nomen Modularis (NAME)" for sake of i18n
@@ -626,7 +628,15 @@ For example, suppose you have a document that starts out:
   Hoo::Boy::Wowza -- Stuff B<wow> yeah!
 
 $parser->get_title on that document will return "Hoo::Boy::Wowza --
-Stuff wow yeah!".
+Stuff wow yeah!". If the document starts with:
+
+  =head1 Name
+  
+  Hoo::Boy::W00t -- Stuff B<w00t> yeah!
+
+Then you'll need to pass the C<nocase> option in order to recognize "Name":
+
+  $parser->get_title(nocase => 1);
 
 In cases where get_title can't find the title, it will return empty-string
 ("").
@@ -652,7 +662,15 @@ But if the document starts out:
   Hooboy, stuff B<wow> yeah!
 
 then $parser->get_short_title on that document will return "Hooboy,
-stuff wow yeah!".
+stuff wow yeah!". If the document starts with:
+
+  =head1 Name
+  
+  Hoo::Boy::W00t -- Stuff B<w00t> yeah!
+
+Then you'll need to pass the C<nocase> option in order to recognize "Name":
+
+  $parser->get_short_title(nocase => 1);
 
 If the title can't be found, then get_short_title returns empty-string
 ("").
@@ -661,22 +679,30 @@ If the title can't be found, then get_short_title returns empty-string
 
 This works like get_title except that it returns the contents of the
 "=head1 AUTHOR\n\nParagraph...\n" section, assuming that that section
-isn't terribly long.
+isn't terribly long. To recognize a "=head1 Author\n\nParagraph\n"
+section, pass the C<nocase> otpion:
+
+  $parser->get_author(nocase => 1);
 
 (This method tolerates "AUTHORS" instead of "AUTHOR" too.)
 
 =item $description_name = $parser->get_description
 
 This works like get_title except that it returns the contents of the
-"=head1 PARAGRAPH\n\nParagraph...\n" section, assuming that that section
-isn't terribly long.
+"=head1 DESCRIPTION\n\nParagraph...\n" section, assuming that that section
+isn't terribly long. To recognize a "=head1 Description\n\nParagraph\n"
+section, pass the C<nocase> otpion:
+
+  $parser->get_description(nocase => 1);
 
 =item $version_block = $parser->get_version
 
 This works like get_title except that it returns the contents of
 the "=head1 VERSION\n\n[BIG BLOCK]\n" block.  Note that this does NOT
-return the module's C<$VERSION>!!
+return the module's C<$VERSION>!! To recognize a
+"=head1 Version\n\n[BIG BLOCK]\n" section, pass the C<nocase> otpion:
 
+  $parser->get_version(nocase => 1);
 
 =back
 
diff --git a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm
index e7832e6aea..e04da3b59b 100644
--- a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm
+++ b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm
@@ -28,7 +28,7 @@ L<Pod::Simple::HTML>, but it largely preserves the same interface.
 package Pod::Simple::XHTML;
 use strict;
 use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.04';
+$VERSION = '3.09';
 use Carp ();
 use Pod::Simple::Methody ();
 @ISA = ('Pod::Simple::Methody');
@@ -137,8 +137,6 @@ to the empty string.
 
 =head2 index
 
-TODO -- Not implemented.
-
 Whether to add a table-of-contents at the top of each page (called an
 index for the sake of tradition).
 
@@ -181,10 +179,14 @@ sub new {
   $new->{'output_fh'} ||= *STDOUT{IO};
   $new->accept_targets( 'html', 'HTML' );
   $new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
-  $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">');
+  $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />');
   $new->nix_X_codes(1);
   $new->codes_in_verbatim(1);
   $new->{'scratch'} = '';
+  $new->{'to_index'} = [];
+  $new->{'output'} = [];
+  $new->{'saved'} = [];
+  $new->{'ids'} = {};
   return $new;
 }
 
@@ -214,7 +216,7 @@ something like:
   sub handle_text {
       my ($self, $text) = @_;
       if ($self->{'in_foo'}) {
-          $self->{'scratch'} .= build_foo_html($text); 
+          $self->{'scratch'} .= build_foo_html($text);
       } else {
           $self->{'scratch'} .= $text;
       }
@@ -224,48 +226,84 @@ something like:
 
 sub handle_text {
     # escape special characters in HTML (<, >, &, etc)
-    $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1]
+    $_[0]{'scratch'} .= encode_entities( $_[1] )
 }
 
 sub start_Para     { $_[0]{'scratch'} = '<p>' }
-sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1}
+sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>' }
+
+sub start_head1 {  $_[0]{'in_head'} = 1 }
+sub start_head2 {  $_[0]{'in_head'} = 2 }
+sub start_head3 {  $_[0]{'in_head'} = 3 }
+sub start_head4 {  $_[0]{'in_head'} = 4 }
 
-sub start_head1 {  $_[0]{'scratch'} = '<h1>' }
-sub start_head2 {  $_[0]{'scratch'} = '<h2>' }
-sub start_head3 {  $_[0]{'scratch'} = '<h3>' }
-sub start_head4 {  $_[0]{'scratch'} = '<h4>' }
+sub start_item_number {
+    $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '<li><p>';
+    $_[0]{'in_li'} = 1
+}
 
-sub start_item_bullet { $_[0]{'scratch'} = '<li>' }
-sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. "  }
-sub start_item_text   { $_[0]{'scratch'} = '<li>'   }
+sub start_item_bullet {
+    $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '<li><p>';
+    $_[0]{'in_li'} = 1
+}
+
+sub start_item_text   {
+    $_[0]{'scratch'} = "</dd>\n" if delete $_[0]{'in_dd'};
+    $_[0]{'scratch'} .= '<dt>';
+}
 
 sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
-sub start_over_text   { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_text   { $_[0]{'scratch'} = '<dl>'; $_[0]->emit }
 sub start_over_block  { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
 sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit }
 
-sub end_over_bullet { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
-sub end_over_text   { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
 sub end_over_block  { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
-sub end_over_number { $_[0]{'scratch'} .= '</ol>'; $_[0]->emit }
+
+sub end_over_number   {
+    $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '</ol>';
+    $_[0]->emit;
+}
+
+sub end_over_bullet   {
+    $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '</ul>';
+    $_[0]->emit;
+}
+
+sub end_over_text   {
+    $_[0]{'scratch'} = "</dd>\n" if delete $_[0]{'in_dd'};
+    $_[0]{'scratch'} .= '</dl>';
+    $_[0]->emit;
+}
 
 # . . . . . Now the actual formatters:
 
 sub end_Para     { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
 sub end_Verbatim {
     $_[0]{'scratch'}     .= '</code></pre>';
-    $_[0]{'in_verbatim'}  = 0;
     $_[0]->emit;
 }
 
-sub end_head1       { $_[0]{'scratch'} .= '</h1>'; $_[0]->emit }
-sub end_head2       { $_[0]{'scratch'} .= '</h2>'; $_[0]->emit }
-sub end_head3       { $_[0]{'scratch'} .= '</h3>'; $_[0]->emit }
-sub end_head4       { $_[0]{'scratch'} .= '</h4>'; $_[0]->emit }
+sub _end_head {
+    my $h = delete $_[0]{in_head};
+    my $id = $_[0]->idify($_[0]{scratch});
+    my $text = $_[0]{scratch};
+    $_[0]{'scratch'} = qq{<h$h id="$id">$text</h$h>};
+    $_[0]->emit;
+    push @{ $_[0]{'to_index'} }, [$h, $id, $text];
+}
+
+sub end_head1       { shift->_end_head(@_); }
+sub end_head2       { shift->_end_head(@_); }
+sub end_head3       { shift->_end_head(@_); }
+sub end_head4       { shift->_end_head(@_); }
 
-sub end_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
-sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
-sub end_item_text   { $_[0]->emit }
+sub end_item_bullet { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
+sub end_item_number { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
+sub end_item_text   { $_[0]{'scratch'} .= "</dt>\n<dd>"; $_[0]{'in_dd'} = 1; $_[0]->emit }
 
 # This handles =begin and =for blocks of all kinds.
 sub start_for { 
@@ -313,8 +351,49 @@ HTML
   }
 }
 
-sub end_Document   { 
+sub end_Document   {
   my ($self) = @_;
+  my $to_index = $self->{'to_index'};
+  if ($self->index && @{ $to_index } ) {
+      my @out;
+      my $level  = 0;
+      my $indent = -1;
+      my $space  = '';
+      my $id     = ' id="index"';
+
+      for my $h (@{ $to_index }, [0]) {
+          my $target_level = $h->[0];
+          # Get to target_level by opening or closing ULs
+          if ($level == $target_level) {
+              $out[-1] .= '</li>';
+          } elsif ($level > $target_level) {
+              $out[-1] .= '</li>' if $out[-1] =~ /^\s+<li>/;
+              while ($level > $target_level) {
+                  --$level;
+                  push @out, ('  ' x --$indent) . '</li>' if @out && $out[-1] =~ m{^\s+<\/ul};
+                  push @out, ('  ' x --$indent) . '</ul>';
+              }
+              push @out, ('  ' x --$indent) . '</li>' if $level;
+          } else {
+              while ($level < $target_level) {
+                  ++$level;
+                  push @out, ('  ' x ++$indent) . '<li>' if @out && $out[-1]=~ /^\s*<ul/;
+                  push @out, ('  ' x ++$indent) . "<ul$id>";
+                  $id = '';
+              }
+              ++$indent;
+          }
+
+          next unless $level;
+          $space = '  '  x $indent;
+          push @out, sprintf '%s<li><a href="#%s">%s</a>',
+              $space, $h->[1], $h->[2];
+      }
+      # Splice the index in between the HTML headers and the first element.
+      my $offset = defined $self->html_header ? $self->html_header eq '' ? 0 : 1 : 1;
+      splice @{ $self->{'output'} }, $offset, 0, join "\n", @out;
+  }
+
   if (defined $self->html_footer) {
     $self->{'scratch'} .= $self->html_footer;
     $self->emit unless $self->html_footer eq "";
@@ -322,17 +401,45 @@ sub end_Document   {
     $self->{'scratch'} .= "</body>\n</html>";
     $self->emit;
   }
+
+  if ($self->index) {
+      print {$self->{'output_fh'}} join ("\n\n", @{ $self->{'output'} }), "\n\n";
+      @{$self->{'output'}} = ();
+  }
+
 }
 
 # Handling code tags
 sub start_B { $_[0]{'scratch'} .= '<b>' }
 sub end_B   { $_[0]{'scratch'} .= '</b>' }
 
-sub start_C { $_[0]{'scratch'} .= '<code>'; $_[0]{'in_verbatim'} = 1; }
-sub end_C   { $_[0]{'scratch'} .= '</code>'; $_[0]{'in_verbatim'} = 0; }
+sub start_C { $_[0]{'scratch'} .= '<code>' }
+sub end_C   { $_[0]{'scratch'} .= '</code>' }
 
-sub start_E { $_[0]{'scratch'} .= '&' }
-sub end_E   { $_[0]{'scratch'} .= ';' }
+sub start_E {
+  my ($self, $flags) = @_;
+  push @{ $self->{'saved'} }, $self->{'scratch'};
+  $self->{'scratch'} = '';
+}
+sub end_E   {
+  my ($self, $flags) = @_;
+  my $previous = pop @{ $self->{'saved'} };
+  my $entity = $self->{'scratch'};
+
+  if ($entity =~ 'sol' or $entity =~ 'verbar') {
+    my $char = Pod::Escapes::e2char($entity);
+    if (defined($char)) {
+      $self->{'scratch'} = $previous . $char;
+      return;
+    }
+  }
+
+  if ($entity =~ /^[0-9]/) {
+      $entity = '#' . $entity;
+  }
+
+  $self->{'scratch'} = $previous . '&'. $entity . ';'
+}
 
 sub start_F { $_[0]{'scratch'} .= '<i>' }
 sub end_F   { $_[0]{'scratch'} .= '</i>' }
@@ -363,12 +470,64 @@ sub end_S   { $_[0]{'scratch'} .= '</nobr>' }
 
 sub emit {
   my($self) = @_;
-  my $out = $self->{'scratch'} . "\n";
-  print {$self->{'output_fh'}} $out, "\n";
+  if ($self->index) {
+      push @{ $self->{'output'} }, $self->{'scratch'};
+  } else {
+      print {$self->{'output_fh'}} $self->{'scratch'}, "\n\n";
+  }
   $self->{'scratch'} = '';
   return;
 }
 
+=head2 idify
+
+  my $id   = $pod->idify($text);
+  my $hash = $pod->idify($text, 1);
+
+This method turns an arbitrary string into a valid XHTML ID attribute value.
+The rules enforced, following
+L<http://webdesign.about.com/od/htmltags/a/aa031707.htm>, are:
+
+=over
+
+=item *
+
+The id must start with a letter (a-z or A-Z)
+
+=item *
+
+All subsequent characters can be letters, numbers (0-9), hyphens (-),
+underscores (_), colons (:), and periods (.).
+
+=item *
+
+Each id must be unique within the document.
+
+=back
+
+In addition, the returned value will be unique within the context of the
+Pod::Simple::XHTML object unless a second argument is passed a true value. ID
+attributes should always be unique within a single XHTML document, but pass
+the true value if you are creating not an ID but a URL hash to point to
+an ID (i.e., if you need to put the "#foo" in C<< <a href="#foo">foo</a> >>.
+
+=cut
+
+sub idify {
+    my ($self, $t, $not_unique) = @_;
+    for ($t) {
+        s/<[^>]+>//g;            # Strip HTML.
+        s/&[^;]+;//g;            # Strip entities.
+        s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
+        s/^[^a-zA-Z]+//;         # First char must be a letter.
+        s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
+    }
+    return $t if $not_unique;
+    my $i = '';
+    $i++ while $self->{ids}{"$t$i"}++;
+    return "$t$i";
+}
+
 # Bypass built-in E<> handling to preserve entity encoding
 sub _treat_Es {} 
 
@@ -385,8 +544,7 @@ L<Pod::Simple>, L<Pod::Simple::Methody>
 Copyright (c) 2003-2005 Allison Randal.
 
 This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself. The full text of the license
-can be found in the LICENSE file included with this module.
+it under the same terms as Perl itself.
 
 This library is distributed in the hope that it will be useful, but
 without any warranty; without even the implied warranty of