Here is the followup patch I promised. The cahnges are
- Change <a> anchors so items can also contain links
- Change resolve_pod_page_link to have a reasonable default
- Move escaping of $to text into resolve_pod_page_link so a subclass
will get the un-escaped version
- Add a hook for when anchors are added. search needs this as it somtimes
inserts a duplicate anchor so that /perldoc?perlfunc#pack will work
- Add <div class=pod>
- Add a contents method
Graham.
--- lib/Pod/Simple/HTML.pm.valid Thu Mar 13 16:01:46 2003
+++ lib/Pod/Simple/HTML.pm Thu Mar 27 19:36:04 2003
@@ -5,7 +5,7 @@
use Pod::Simple::PullParser ();
use vars qw(@ISA %Tagmap $Computerese $Linearization_Limit $VERSION);
@ISA = ('Pod::Simple::PullParser');
-$VERSION = '1.03_01';
+$VERSION = '1.03_02';
use UNIVERSAL ();
sub DEBUG () {0}
@@ -30,10 +30,10 @@
'head2' => "\n<h2>", # ''
'head3' => "\n<h3>", # ''
'head4' => "\n<h4>", # ''
- '/head1' => "</a></h1>\n",
- '/head2' => "</a></h2>\n",
- '/head3' => "</a></h3>\n",
- '/head4' => "</a></h4>\n",
+ '/head1' => "</h1>\n",
+ '/head2' => "</h2>\n",
+ '/head3' => "</h3>\n",
+ '/head4' => "</h4>\n",
'X' => "<!--\n\tINDEX: ",
'/X' => "\n-->",
@@ -70,7 +70,7 @@
'/item-bullet' => "</li>\n",
'/item-number' => "</li>\n",
- '/item-text' => "</a></dt>\n",
+ '/item-text' => "</dt>\n",
'item-body' => "\n<dd>",
'/item-body' => "</dd>\n",
@@ -141,11 +141,7 @@
$section = $self->unicode_escape_url($section);
# Turn char 1234 into "(1234)"
$section = '_' unless length $section;
- }
-
- foreach my $it ($to, $section) {
- $it =~
s/([^\._abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg
- if defined $it;
+ $section =~
s/([^\._abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg;
# Yes, stipulate the list without a range, so that this can work right on
# all charsets that this module happens to run under.
# Altho, hmm, what about that ord? Presumably that won't work right
@@ -160,9 +156,14 @@
sub resolve_pod_page_link {
- my($self, $to) = @_;
-
- return 'TODO';
+ (my $to = $_[1]) =~
s/([^\._abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg;
+ # Yes, stipulate the list without a range, so that this can work right on
+ # all charsets that this module happens to run under.
+ # Altho, hmm, what about that ord? Presumably that won't work right
+ # under non-ASCII charsets. Something should be done about that.
+
+ "http://search.cpan.org/perldoc?$to";;
+ # We should make this configurable, but this is a good default
}
sub do_url_link { return $_[1]->attr('to') }
@@ -188,6 +189,8 @@
}
+sub do_anchor { $_[1] }
+
sub do_middle { # the main work
my $self = $_[0];
my $fh = $self->{'output_fh'};
@@ -224,14 +227,16 @@
and $to_unget[-1]->tagname eq $tagname;
}
my $name = $self->linearize_tokens(@to_unget);
+ $name = $self->do_anchor($name, $token) if defined $name;
if(defined $name) { # ludicrously long, so nevermind
+ push @{$self->{contents}}, [ $1, $name ]
+ if $tagname =~ m/^head(\d)$/;
$name =~ tr/ /_/;
- print $fh "<a name=\"", esc($name), "\"\n>";
+ print $fh "<a name=\"", esc($name), "\"></a\n>";
DEBUG and print "Linearized ", scalar(@to_unget),
" tokens as \"$name\".\n";
} else {
- print $fh "<a\n>"; # Yes, an 'a' element with no attributes!
DEBUG and print "Linearized ", scalar(@to_unget),
" tokens, but it was too long, so nevermind.\n";
}
@@ -270,7 +275,7 @@
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 ) {
- print $tagmap->{"/item-text"},$tagmap->{"item-body"};
+ print $fh $tagmap->{"/item-text"},$tagmap->{"item-body"};
$stack[-1] = $tagmap->{"/item-body"};
}
}
@@ -287,6 +292,7 @@
}
}
+ print $fh "<!-- end doc -->\n";
return 1;
}
@@ -320,7 +326,7 @@
qq{<html><head>\n};
$self->do_head;
- print {$self->{'output_fh'}} "</head><body>\n";
+ print {$self->{'output_fh'}} "</head><body><div class=pod>\n";
# TODO: more configurability there
@@ -341,7 +347,7 @@
sub do_end {
my $self = $_[0];
- print {$self->{'output_fh'}} "\n<!-- end doc -->\n</body></html>\n";
+ print {$self->{'output_fh'}} "</div>\n</body></html>\n";
# TODO: allow for a footer
return 1;
}
@@ -413,6 +419,30 @@
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub contents {
+ my $self = shift;
+ my $contents = $self->{contents}
+ or return '';
+ my $str = '';
+ my $lvl = 0;
+ foreach my $entry (@$contents) {
+ my ($nlvl, $label) = @$entry;
+ if (my $n = $nlvl - $lvl) {
+ if ($n > 0) {
+ $str .= substr("<li><ul>" x $n, 4);
+ }
+ else {
+ $str .= "</ul>\n" x -$n;
+ }
+ $lvl = $nlvl;
+ }
+ (my $name = $label) =~ tr/ /_/;
+ $str .= sprintf qq{<li><a href="#%s">%s</a>\n}, esc($name),esc($label);
+ }
+ $str .= "</ul>\n" x $lvl;
+ $str;
+}
1;
__END__
