From 9d65762f3680caf03a8526c0d9868a9b366f7818 Mon Sep 17 00:00:00 2001 From: "David E. Wheeler" Date: Tue, 27 Oct 2009 12:09:33 -0700 Subject: Bring Pod::Simple up to 3.09 as on CPAN. --- cpan/Pod-Simple/lib/Pod/Simple.pm | 9 +- cpan/Pod-Simple/lib/Pod/Simple.pod | 50 +++++- cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm | 41 ++++- cpan/Pod-Simple/lib/Pod/Simple/Debug.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/HTML.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm | 55 ++++--- cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm | 38 ++++- cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm | 228 +++++++++++++++++++++++---- 8 files changed, 342 insertions(+), 83 deletions(-) (limited to 'cpan/Pod-Simple/lib/Pod') 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 -will turn off C or vice versa -- these are -independent attributes. +Setting C also sets C. =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 ) >> + +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. Say +that you don't want I 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 The article "Constants in Perl", in I issue -21. See L +21. See L =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 ); 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 or C that class so that's it's loaded before +Pod::Simple::HTMLBatch tries loading it. + +=item $batchconv->search_class( I ); + +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 or C 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 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 yeah! + +Then you'll need to pass the C 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 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 yeah! + +Then you'll need to pass the C 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 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 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 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, 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(''); + $new->html_header_tags(''); $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'} = '

' } -sub start_Verbatim { $_[0]{'scratch'} = '

'; $_[0]{'in_verbatim'} = 1}
+sub start_Verbatim { $_[0]{'scratch'} = '
' }
+
+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'} = '
' }
-sub start_head2 {  $_[0]{'scratch'} = '
' }
-sub start_head3 {  $_[0]{'scratch'} = '
' }
-sub start_head4 {  $_[0]{'scratch'} = '
' }
+sub start_item_number {
+    $_[0]{'scratch'} = "\n" if $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '
  • ';
+    $_[0]{'in_li'} = 1
+}
 
-sub start_item_bullet { $_[0]{'scratch'} = '
  • ' }
-sub start_item_number { $_[0]{'scratch'} = "
  • $_[1]{'number'}. "  }
-sub start_item_text   { $_[0]{'scratch'} = '
  • '   }
+sub start_item_bullet {
+    $_[0]{'scratch'} = "
    • \n" if $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '
  • ';
+    $_[0]{'in_li'} = 1
+}
+
+sub start_item_text   {
+    $_[0]{'scratch'} = "\n" if delete $_[0]{'in_dd'};
+    $_[0]{'scratch'} .= '
    ';
+}
 
 sub start_over_bullet { $_[0]{'scratch'} = '
      '; $_[0]->emit }
-sub start_over_text   { $_[0]{'scratch'} = '
        '; $_[0]->emit }
+sub start_over_text   { $_[0]{'scratch'} = '
        '; $_[0]->emit }
 sub start_over_block  { $_[0]{'scratch'} = '
          '; $_[0]->emit }
 sub start_over_number { $_[0]{'scratch'} = '
            '; $_[0]->emit }
 
-sub end_over_bullet { $_[0]{'scratch'} .= '
        '; $_[0]->emit }
-sub end_over_text   { $_[0]{'scratch'} .= '
      '; $_[0]->emit }
 sub end_over_block  { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
-sub end_over_number { $_[0]{'scratch'} .= ''; $_[0]->emit }
+
+sub end_over_number   {
+    $_[0]{'scratch'} = "
    • \n" if delete $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '';
+    $_[0]->emit;
+}
+
+sub end_over_bullet   {
+    $_[0]{'scratch'} = "\n" if delete $_[0]{'in_li'};
+    $_[0]{'scratch'} .= '';
+    $_[0]->emit;
+}
+
+sub end_over_text   {
+    $_[0]{'scratch'} = "\n" if delete $_[0]{'in_dd'};
+    $_[0]{'scratch'} .= '';
+    $_[0]->emit;
+}
 
 # . . . . . Now the actual formatters:
 
 sub end_Para     { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
 sub end_Verbatim {
     $_[0]{'scratch'}     .= '
    ';
-    $_[0]{'in_verbatim'}  = 0;
     $_[0]->emit;
 }
 
-sub end_head1       { $_[0]{'scratch'} .= ''; $_[0]->emit }
-sub end_head2       { $_[0]{'scratch'} .= ''; $_[0]->emit }
-sub end_head3       { $_[0]{'scratch'} .= ''; $_[0]->emit }
-sub end_head4       { $_[0]{'scratch'} .= ''; $_[0]->emit }
+sub _end_head {
+    my $h = delete $_[0]{in_head};
+    my $id = $_[0]->idify($_[0]{scratch});
+    my $text = $_[0]{scratch};
+    $_[0]{'scratch'} = qq{$text};
+    $_[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'} .= ''; $_[0]->emit }
-sub end_item_number { $_[0]{'scratch'} .= ''; $_[0]->emit }
-sub end_item_text   { $_[0]->emit }
+sub end_item_bullet { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
+sub end_item_number { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
+sub end_item_text   { $_[0]{'scratch'} .= "\n
    "; $_[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] .= '';
+          } elsif ($level > $target_level) {
+              $out[-1] .= '' if $out[-1] =~ /^\s+
  • /;
+              while ($level > $target_level) {
+                  --$level;
+                  push @out, ('  ' x --$indent) . '
    • ' if @out && $out[-1] =~ m{^\s+<\/ul};
+                  push @out, ('  ' x --$indent) . '';
+              }
+              push @out, ('  ' x --$indent) . '' if $level;
+          } else {
+              while ($level < $target_level) {
+                  ++$level;
+                  push @out, ('  ' x ++$indent) . '
  • ' if @out && $out[-1]=~ /^\s*
      ";
+                  $id = '';
+              }
+              ++$indent;
+          }
+
+          next unless $level;
+          $space = '  '  x $indent;
+          push @out, sprintf '%s
    • %s',
+              $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'} .= "\n";
     $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'} .= '' }
 sub end_B   { $_[0]{'scratch'} .= '' }
 
-sub start_C { $_[0]{'scratch'} .= ''; $_[0]{'in_verbatim'} = 1; }
-sub end_C   { $_[0]{'scratch'} .= ''; $_[0]{'in_verbatim'} = 0; }
+sub start_C { $_[0]{'scratch'} .= '' }
+sub end_C   { $_[0]{'scratch'} .= '' }
 
-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'} .= '' }
 sub end_F   { $_[0]{'scratch'} .= '' }
@@ -363,12 +470,64 @@ sub end_S   { $_[0]{'scratch'} .= '' }
 
 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, 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<< foo >>.
+
+=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, L
 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
-- 
cgit v1.2.1