cpan/Pod-Simple/ChangeLog | 60 ++++-
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 ++++++++++++---
cpan/Pod-Simple/t/corpus.t | 4 +-
cpan/Pod-Simple/t/corpus2/README | 3 +
cpan/Pod-Simple/t/fcodes.t | 16 +-
cpan/Pod-Simple/t/fcodes_l.t | 42 ++--
cpan/Pod-Simple/t/fcodes_s.t | 2 +-
cpan/Pod-Simple/t/html01.t | 21 ++-
cpan/Pod-Simple/t/htmlbat.t | 35 ++-
cpan/Pod-Simple/t/items02.t | 88 +++---
cpan/Pod-Simple/t/pulltitl.t | 26 ++-
cpan/Pod-Simple/t/reinit.t | 2 +-
cpan/Pod-Simple/t/search20.t | 8 +-
cpan/Pod-Simple/t/search22.t | 8 +-
cpan/Pod-Simple/t/search50.t | 30 ++-
cpan/Pod-Simple/t/strpvbtm.t | 111 +++++++
cpan/Pod-Simple/t/xhtml01.t | 136 ++++++++--
cpan/Pod-Simple/t/xhtml10.t | 408 ++++++++++++++++++++++++++
25 files changed, 1219 insertions(+), 206 deletions(-)
create mode 100644 cpan/Pod-Simple/t/corpus2/README
create mode 100644 cpan/Pod-Simple/t/strpvbtm.t
create mode 100644 cpan/Pod-Simple/t/xhtml10.t
diff --git a/cpan/Pod-Simple/ChangeLog b/cpan/Pod-Simple/ChangeLog
index 4ab15b2..c36a6f1 100644
--- a/cpan/Pod-Simple/ChangeLog
+++ b/cpan/Pod-Simple/ChangeLog
@@ -1,14 +1,70 @@
# ChangeLog for Pod::Simple dist
#---------------------------------------------------------------------------
+2009-10-27 Allison Randal <[email protected]>
+ * Release 3.09
+
+ Add support for an index (TOC) in the XHTML output from David E.
+ Wheeler.
+
+ Add strip_verbatim_indent() from David E. Wheeler.
+
+ Added the "nocase" option to PullParser's get_title(),
+ get_version(), get_description(), and get_author() methods. This
+ allows one to fetch the contents of those sections regardless of
+ the case of the labels (e.g., "NAME" and "Name" and "name" are all
+ valid). Graham Barr.
+
+ Added the search_class() accessor to Pod::Simple::HTMLBatch.
+ David E. Wheeler.
+
+ XHTML output now properly encodes entities in all places, not just
+ in verbatim blocks and code spans. David E. Wheeler.
+
+ Fixed XHTML to output definition lists when it should, rather than
+ (broken) unordered lists. David E. Wheeler.
+
+ Fixed XHTML so that multiparagraph list items work correctly.
+ David E. Wheeler.
+
+ Fixed XHTML ordered list output so that it does not include the
+ number specified in the POD in the output. This is on a par with
+ out the HTML output works. David E. Wheeler.
+
+ Applied URL patch from Leon Brocard for The Perl Journal archives.
+
+ Fixed test failures with older versions of HTML::Entities (RT #43903
+ from Salvador Tercia).
+
+ Changed CSS files generated by HTMLBatch to be no more than 8.3
+ characters long. (RT #40450 from Renee Baecker)
+
+ Added entity handling for E<sol> and E<verbar> to Pod::Simple::XHTML.
+ (RT #49615 from Chas Owens.)
+
+ Fixed a bug in Pod::Simple::HTML where a definition term item with
+ no corresponding definition item would be output with no closing
+ </a></dt>. (RT # 37107 from Kevin Ryde).
+
+ Added entity handling for numeric entities to Pod::Simple::XHTML,
+ following perlpod specification.
+
+ A POD tag found inside a complex POD tag (e.g., "C<<< C<foo> >>>")
+ is now properly parsed as text and entities instead of a tag
+ embedded in a tag. This is in compliance with `perldoc perlpod`
+ (RT #12239 from Michael Schwern).
+
+ Thanks to David E. Wheeler for applying patches, resolving bugs,
+ and generally getting ready for the release.
+
2009-07-16 Allison Randal <[email protected]>
* Release 3.08
Fix installdirs for Perl versions where Pod::Simple was core;
- RT#36446 & RT#39709, thanks to Jerry Hedden.
+ RT#36446 & RT#39709, thanks to Jerry Hedden.
Fix encoding handling for code in paragraphs; RT#45829, thanks
- to David Wheeler.
+ to David Wheeler.
2008-06-04 Allison Randal <[email protected]>
* Release 3.07
diff --git a/cpan/Pod-Simple/lib/Pod/Simple.pm b/cpan/Pod-Simple/lib/Pod/Simple.pm
index 1089099..a122bf7 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 a582173..b9e13a6 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 4804973..65438df 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 b00e58d..7747f0b 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 a4dbbc1..44c5555 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 cb26cab..96093fb 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 15d9731..1a6a471 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 e7832e6..e04da3b 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
diff --git a/cpan/Pod-Simple/t/corpus.t b/cpan/Pod-Simple/t/corpus.t
index da54f99..3427b91 100644
--- a/cpan/Pod-Simple/t/corpus.t
+++ b/cpan/Pod-Simple/t/corpus.t
@@ -129,9 +129,7 @@ foreach my $f (@testfiles) {
next if $f =~ /nonesuch/;
- # foo.xml.out is not a portable filename. foo.xml_out may be a bit more portable
-
- my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}_out";
+ my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}\_out";
if($HACK) {
open OUT, ">$outfilename" or die "Can't write-open $outfilename: $!\n";
binmode(OUT);
diff --git a/cpan/Pod-Simple/t/corpus2/README b/cpan/Pod-Simple/t/corpus2/README
new file mode 100644
index 0000000..de30cb2
--- /dev/null
+++ b/cpan/Pod-Simple/t/corpus2/README
@@ -0,0 +1,3 @@
+This is a corpus of data that hasn't been implemented yet. It's
+included for future reference, and will be moved to the main corpus
+directory as it is implemented.
diff --git a/cpan/Pod-Simple/t/fcodes.t b/cpan/Pod-Simple/t/fcodes.t
index 02e2a27..7dbf14b 100644
--- a/cpan/Pod-Simple/t/fcodes.t
+++ b/cpan/Pod-Simple/t/fcodes.t
@@ -7,7 +7,7 @@ BEGIN {
use strict;
use Test;
-BEGIN { plan tests => 18 };
+BEGIN { plan tests => 21 };
#use Pod::Simple::Debug (5);
@@ -81,14 +81,24 @@ ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< a >>C<<< b >>>I<<<< c >>>>B<< d
print "# Without any nesting, but with Z's, and odder whitespace...\n";
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>b >>>I<<<< c >>>>B<< d \t >>X<<\ne >>\n"),
- '<Document><Para><F>a</F><C>b</C><I>c</I><B>d</B><X>e</X></Para></Document>'
+ '<Document><Para><F>aZ<></F><C>Z<>b</C><I>c</I><B>d</B><X>e</X></Para></Document>'
);
print "# With nesting and Z's, and odder whitespace...\n";
ok( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>bZ<>B<< d \t >>X<<\ne >> >>>I<<<< c >>>>\n"),
- '<Document><Para><F>a</F><C>b<B>d</B><X>e</X></C><I>c</I></Para></Document>'
+ "<Document><Para><F>aZ<></F><C>Z<>bZ<>B<< d >>X<< e >></C><I>c</I></Para></Document>"
);
+print "# Regression https://rt.cpan.org/Ticket/Display.html?id=12239\n";
+ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< foo->bar >>>\n"),
+ '<Document><Para><C>foo->bar</C></Para></Document>'
+);
+ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C<foo> >>>\n"),
+ '<Document><Para><C>C<foo></C></Para></Document>'
+);
+ok( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C<<foo>> >>>\n"),
+ '<Document><Para><C>C<<foo>></C></Para></Document>'
+);
print "# Misc...\n";
ok( Pod::Simple::XMLOutStream->_out(
diff --git a/cpan/Pod-Simple/t/fcodes_l.t b/cpan/Pod-Simple/t/fcodes_l.t
index 17be5db..3a32fbc 100644
--- a/cpan/Pod-Simple/t/fcodes_l.t
+++ b/cpan/Pod-Simple/t/fcodes_l.t
@@ -337,32 +337,32 @@ print "#\n# Now some very complex L<text|stuff> tests with variant syntax...\n";
ok( $x->_out(qq{=pod\n\nL<< Perl B<<< Error E<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
+ '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>',
);
ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
+ '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>\n}),
- '<Document><Para><L to="perldiag" type="pod">Perl <B>Error Messages</B></L></Para></Document>'
+ '<Document><Para><L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>\n}),
- '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>'
+ '<Document><Para><L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/"Basic <I>BLOCKs</I> and Switch Statements" >></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>\n}),
- '<Document><Para><L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L></Para></Document>'
+ '<Document><Para><L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/Basic <I>BLOCKs</I> and Switch Statements >></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/"Member Data" >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/Member Data >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
);
ok( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|"Member Data" >>>\n}),
- '<Document><Para><L section="Member Data" type="pod">the <F>various</F> attributes</L></Para></Document>'
+ '<Document><Para><L section="Member Data" type="pod">the F<< various >> attributes</L></Para></Document>'
);
###########################################################################
@@ -371,51 +371,51 @@ print "#\n# Now some very complex L<text|stuff> tests with variant syntax and te
ok( $x->_out(qq{=pod\n\nI like L<< Perl B<<< Error E<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
+ '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
+ '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>.\n}),
- '<Document><Para>I like <L to="perldiag" type="pod">Perl <B>Error Messages</B></L>.</Para></Document>'
+ '<Document><Para>I like <L content-implicit="yes" section="Perl B<<< Error E<77>essages" type="pod">"Perl B<<< Error E<77>essages"</L>>|perldiag >>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>.\n}),
- '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>'
+ '<Document><Para>I like <L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/"Basic <I>BLOCKs</I> and Switch Statements" >>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>.\n}),
- '<Document><Para>I like <L section="Basic BLOCKs and Switch Statements" to="perlsyn" type="pod">SWITCH <B>statements</B></L>.</Para></Document>'
+ '<Document><Para>I like <L content-implicit="yes" section="SWITCH B<<< E<115>tatements" type="pod">"SWITCH B<<< E<115>tatements"</L>>|perlsyn/Basic <I>BLOCKs</I> and Switch Statements >>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/"Member Data" >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/Member Data >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|"Member Data" >>>.\n}),
- '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
+ '<Document><Para>I like <L section="Member Data" type="pod">the F<< various >> attributes</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< B<text>s|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url"><B>text</B>s</L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url">B<text>s</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}),
'<Document><Para>I like <L to="https://text.com/1/2" type="url">text</L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< I<text>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url"><I>text</I></L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url">I<text></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< C<text>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url"><C>text</C></L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url">C<text></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< I<tI<eI<xI<t>>>>|mailto:earlE<64>text.com >>>.\n}),
-'<Document><Para>I like <L to="mailto:[email protected]" type="url"><I>t<I>e<I>x<I>t</I></I></I></I></L>.</Para></Document>'
+'<Document><Para>I like <L to="mailto:earlE<64>text.com" type="url">I<tI<eI<xI<t>>>></L>.</Para></Document>'
);
ok( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}),
-'<Document><Para>I like <L to="http://text.com" type="url">text</L>.</Para></Document>'
+'<Document><Para>I like <L to="http://text.com" type="url">textZ<></L>.</Para></Document>'
);
diff --git a/cpan/Pod-Simple/t/fcodes_s.t b/cpan/Pod-Simple/t/fcodes_s.t
index 6579021..0c66d2c 100644
--- a/cpan/Pod-Simple/t/fcodes_s.t
+++ b/cpan/Pod-Simple/t/fcodes_s.t
@@ -83,7 +83,7 @@ $x->preserve_whitespace(1);
# RT#25679
ok(
$x->_out(<<END
-=head1 The Tk::mega manpage showed me how C<< SE<lt> E<gt> foo >> is being rendered
+=head1 The Tk::mega manpage showed me how C<< S< > foo >> is being rendered
Both pod2text and pod2man S< > lose the rest of the line
diff --git a/cpan/Pod-Simple/t/html01.t b/cpan/Pod-Simple/t/html01.t
index 2c0b04e..18e84a8 100644
--- a/cpan/Pod-Simple/t/html01.t
+++ b/cpan/Pod-Simple/t/html01.t
@@ -9,7 +9,7 @@ BEGIN {
use strict;
use Test;
-BEGIN { plan tests => 8 };
+BEGIN { plan tests => 9 };
#use Pod::Simple::Debug (10);
@@ -71,6 +71,25 @@ ok(x(
"heading building"
);
+print x("=over 4\n\n=item one\n\n=item two\n\nHello\n\n=back\n");
+ok(
+ x("=over 4\n\n=item one\n\n=item two\n\nHello\n\n=back\n"),
+ q{
+<dl>
+<dt><a name="one"
+>one</a></dt>
+
+<dd>
+<dt><a name="two"
+>two</a></dt>
+
+<dd>
+<p>Hello</p>
+</dd>
+</dl>
+}
+);
+
print "# And one for the road...\n";
ok 1;
diff --git a/cpan/Pod-Simple/t/htmlbat.t b/cpan/Pod-Simple/t/htmlbat.t
index 497f0e5..559754b 100644
--- a/cpan/Pod-Simple/t/htmlbat.t
+++ b/cpan/Pod-Simple/t/htmlbat.t
@@ -8,18 +8,19 @@ BEGIN {
# Time-stamp: "2004-05-24 02:07:47 ADT"
use strict;
+my $DEBUG = 0;
#sub Pod::Simple::HTMLBatch::DEBUG () {5};
use Test;
-BEGIN { plan tests => 8 }
+BEGIN { plan tests => 9 }
require Pod::Simple::HTMLBatch;;
use File::Spec;
use Cwd;
my $cwd = cwd();
-print "# CWD: $cwd\n";
+print "# CWD: $cwd\n" if $DEBUG;
my $t_dir;
my $corpus_dir;
@@ -38,7 +39,7 @@ foreach my $t_maybe (
next unless -e $corpus_dir;
last;
}
-print "# OK, found the test corpus as $corpus_dir\n";
+print "# OK, found the test corpus as $corpus_dir\n" if $DEBUG;
ok 1;
my $outdir;
@@ -54,16 +55,16 @@ END {
}
ok 1;
-print "# Output dir: $outdir\n";
+print "# Output dir: $outdir\n" if $DEBUG;
mkdir $outdir, 0777 or die "Can't mkdir $outdir: $!";
-print "# Converting $corpus_dir => $outdir\n";
+print "# Converting $corpus_dir => $outdir\n" if $DEBUG;
my $conv = Pod::Simple::HTMLBatch->new;
$conv->verbose(0);
$conv->batch_convert( [$corpus_dir], $outdir );
ok 1;
-print "# OK, back from converting.\n";
+print "# OK, back from converting.\n" if $DEBUG;
my @files;
use File::Find;
@@ -79,19 +80,31 @@ find( sub { push @files, $File::Find::name; return }, $outdir );
}
}
-print "#Produced in $outdir ...\n";
-foreach my $f (sort @files) {
- print "# $f\n";
+if ($DEBUG) {
+ print "#Produced in $outdir ...\n";
+ foreach my $f (sort @files) {
+ print "# $f\n";
+ }
+ print "# (", scalar(@files), " items total)\n";
}
-print "# (", scalar(@files), " items total)\n";
# Some minimal sanity checks:
ok scalar(grep m/\.css/i, @files) > 5;
ok scalar(grep m/\.html?/i, @files) > 5;
ok scalar grep m{squaa\W+Glunk.html?}i, @files;
+if (my @long = grep { /^[^.]{9,}/ } map { s{^[^/]/}{} } @files) {
+ ok 0;
+ print "# File names too long:\n",
+ map { "# $_\n" } @long;
+} else {
+ ok 1;
+}
+
+
+
# use Pod::Simple;
# *pretty = \&Pod::Simple::BlackBox::pretty;
-print "# Bye from ", __FILE__, "\n";
+print "# Bye from ", __FILE__, "\n" if $DEBUG;
ok 1;
diff --git a/cpan/Pod-Simple/t/items02.t b/cpan/Pod-Simple/t/items02.t
index 4898fe4..d604baa 100644
--- a/cpan/Pod-Simple/t/items02.t
+++ b/cpan/Pod-Simple/t/items02.t
@@ -1,44 +1,44 @@
-# Testing the =item directive
-BEGIN {
- if($ENV{PERL_CORE}) {
- chdir 't';
- @INC = '../lib';
- }
-}
-
-use strict;
-use Test;
-BEGIN { plan tests => 4 };
-
-my $d;
-#use Pod::Simple::Debug (\$d,0);
-
-ok 1;
-
-use Pod::Simple::DumpAsXML;
-use Pod::Simple::XMLOutStream;
-print "# Pod::Simple version $Pod::Simple::VERSION\n";
-sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }
-
-my $x = 'Pod::Simple::XMLOutStream';
-
-print "##### Tests for =item directives via class $x\n";
-
-$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';
-$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output
-
-
-print "#\n# Tests for =item [number] that are icky...\n";
-ok( $x->_out("\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"),
- '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'
-);
-
-ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),
- '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'
-);
-
-
-print "# Wrapping up... one for the road...\n";
-ok 1;
-print "# --- Done with ", __FILE__, " --- \n";
-
+# Testing the =item directive
+BEGIN {
+ if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 4 };
+
+my $d;
+#use Pod::Simple::Debug (\$d,0);
+
+ok 1;
+
+use Pod::Simple::DumpAsXML;
+use Pod::Simple::XMLOutStream;
+print "# Pod::Simple version $Pod::Simple::VERSION\n";
+sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }
+
+my $x = 'Pod::Simple::XMLOutStream';
+
+print "##### Tests for =item directives via class $x\n";
+
+$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';
+$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output
+
+
+print "#\n# Tests for =item [number] that are icky...\n";
+ok( $x->_out("\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+
+print "# Wrapping up... one for the road...\n";
+ok 1;
+print "# --- Done with ", __FILE__, " --- \n";
+
diff --git a/cpan/Pod-Simple/t/pulltitl.t b/cpan/Pod-Simple/t/pulltitl.t
index abaf83f..c50c932 100644
--- a/cpan/Pod-Simple/t/pulltitl.t
+++ b/cpan/Pod-Simple/t/pulltitl.t
@@ -7,7 +7,7 @@ BEGIN {
use strict;
use Test;
-BEGIN { plan tests => 104 };
+BEGIN { plan tests => 114 };
#use Pod::Simple::Debug (5);
@@ -29,6 +29,7 @@ my $p = Pod::Simple::PullParser->new;
$p->set_source( \qq{\n=head1 NAME\n\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} );
ok $p->get_title(), 'Bzorch';
+
my $t;
ok( $t = $p->get_token);
@@ -48,6 +49,29 @@ ok( $t && $t->type eq 'text' && $t->text, 'NAME' );
###########################################################################
{
+print "# Testing a set with nocase, at line ", __LINE__, "\n";
+my $p = Pod::Simple::PullParser->new;
+$p->set_source( \qq{\n=head1 Name\n\nShazbot\n\n=pod\n\nLala\n\n\=cut\n} );
+
+ok $p->get_title(nocase => 1), 'Shazbot';
+
+ok( my $t = $p->get_token);
+ok( $t && $t->type, 'start');
+ok( $t && $t->type eq 'start' && $t->tagname, 'Document' );
+
+ok( $t = $p->get_token);
+ok( $t && $t->type, 'start');
+ok( $t && $t->type eq 'start' && $t->tagname, 'head1' );
+
+ok( $t = $p->get_token);
+ok( $t && $t->type, 'text');
+ok( $t && $t->type eq 'text' && $t->text, 'Name' );
+
+}
+
+###########################################################################
+
+{
print "# Testing another set, at line ", __LINE__, "\n";
my $p = Pod::Simple::PullParser->new;
diff --git a/cpan/Pod-Simple/t/reinit.t b/cpan/Pod-Simple/t/reinit.t
index c10c65e..8576e99 100644
--- a/cpan/Pod-Simple/t/reinit.t
+++ b/cpan/Pod-Simple/t/reinit.t
@@ -42,7 +42,7 @@ foreach my $file (
next;
}
- my $precooked = source_path($file);
+ my $precooked = $file;
my $outstring;
my $compstring;
$precooked =~ s<\.pod><o.txt>s;
diff --git a/cpan/Pod-Simple/t/search20.t b/cpan/Pod-Simple/t/search20.t
index 3022b36..52c6c36 100644
--- a/cpan/Pod-Simple/t/search20.t
+++ b/cpan/Pod-Simple/t/search20.t
@@ -69,16 +69,12 @@ print $p;
{
my $names = join "|", sort values %$where2name;
-skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
- $names,
- "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
+ok $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
}
{
my $names = join "|", sort keys %$name2where;
-skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
- $names,
- "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
+ok $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
}
ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
diff --git a/cpan/Pod-Simple/t/search22.t b/cpan/Pod-Simple/t/search22.t
index 6e6d662..05157b7 100644
--- a/cpan/Pod-Simple/t/search22.t
+++ b/cpan/Pod-Simple/t/search22.t
@@ -71,17 +71,13 @@ print $p;
{
print "# won't show any shadows, since we're just looking at the name2where keys\n";
my $names = join "|", sort keys %$name2where;
-skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
- $names,
- "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
+ok $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
}
{
print "# but here we'll see shadowing:\n";
my $names = join "|", sort values %$where2name;
-skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
- $names,
- "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|hinkhonk::Vliff|hinkhonk::Vliff|perlflif|perlthng|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo|zikzik";
+ok $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|hinkhonk::Vliff|hinkhonk::Vliff|perlflif|perlthng|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo|zikzik";
my %count;
for(values %$where2name) { ++$count{$_} };
diff --git a/cpan/Pod-Simple/t/search50.t b/cpan/Pod-Simple/t/search50.t
index d207276..55fb8a5 100644
--- a/cpan/Pod-Simple/t/search50.t
+++ b/cpan/Pod-Simple/t/search50.t
@@ -11,7 +11,7 @@ use strict;
use Pod::Simple::Search;
use Test;
-BEGIN { plan tests => 7 }
+BEGIN { plan tests => 8 }
print "# Test the scanning of the whole of \@INC ...\n";
@@ -45,9 +45,12 @@ $p =~ s/^/# /mg;
print $p;
print "# OK, making sure strict and strict.pm were in there...\n";
-ok( ($name2where->{'strict'} || 'huh???'), '/strict\.(pod|pm)$/');
+print "# (On Debian-based distributions Pod is stripped from\n",
+ "# strict.pm, so skip these tests.)\n";
+my $nopod = not exists ($name2where->{'strict'});
+skip($nopod, ($name2where->{'strict'} || 'huh???'), '/strict\.(pod|pm)$/');
-ok grep( m/strict\.(pod|pm)/, keys %$where2name );
+skip($nopod, grep( m/strict\.(pod|pm)/, keys %$where2name ));
my $strictpath = $name2where->{'strict'};
if( $strictpath ) {
@@ -56,8 +59,27 @@ if( $strictpath ) {
for(@x) { s{[/\\]}{/}g; }
print "# => \"$x[0]\" to \"$x[1]\"\n";
ok $x[0], $x[1], " find('strict') should match survey's name2where{strict}";
+} elsif ($nopod) {
+ skip "skipping find() for strict.pm"; # skipping find() for 'thatpath/strict.pm
} else {
- ok 0; # no 'thatpath/strict.pm' means can't test find()
+ ok 0; # an entry without a defined path means can't test find()
+}
+
+print "# Test again on a module we know is present, in case the
+strict.pm tests were skipped...\n";
+
+# Grab the first item in $name2where, since it doesn't matter which we
+# use.
+my $testmod = (keys %$name2where)[0];
+my $testpath = $name2where->{$testmod};
+if( $testmod ) {
+ my @x = ($x->find($testmod)||'(nil)', $testpath);
+ print "# Comparing \"$x[0]\" to \"$x[1]\"\n";
+ for(@x) { s{[/\\]}{/}g; }
+ print "# => \"$x[0]\" to \"$x[1]\"\n";
+ ok $x[0], $x[1], " find('$testmod') should match survey's name2where{$testmod}";
+} else {
+ ok 0; # no 'thatpath/<name>.pm' means can't test find()
}
ok 1;
diff --git a/cpan/Pod-Simple/t/strpvbtm.t b/cpan/Pod-Simple/t/strpvbtm.t
new file mode 100644
index 0000000..9cb83f3
--- /dev/null
+++ b/cpan/Pod-Simple/t/strpvbtm.t
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+
+# t/strip_verbatim_indent.t.t - check verabtim indent stripping feature
+
+BEGIN {
+ chdir 't' if -d 't';
+}
+
+use strict;
+use lib '../lib';
+use Test::More tests => 79;
+#use Test::More 'no_plan';
+
+use_ok('Pod::Simple::XHTML') or exit;
+use_ok('Pod::Simple::XMLOutStream') or exit;
+
+isa_ok my $parser = Pod::Simple::XHTML->new, 'Pod::Simple::XHTML';
+
+ok $parser->strip_verbatim_indent(' '), 'Should be able to set striper to " "';
+ok $parser->strip_verbatim_indent(' '), 'Should be able to set striper to " "';
+ok $parser->strip_verbatim_indent("t"), 'Should be able to set striper to "\\t"';
+ok $parser->strip_verbatim_indent(sub { ' ' }), 'Should be able to set striper to coderef';
+
+for my $spec (
+ [
+ "\n=pod\n\n foo bar baz\n",
+ undef,
+ qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>},
+ "<pre><code> foo bar baz</code></pre>\n\n",
+ 'undefined indent'
+ ],
+ [
+ "\n=pod\n\n foo bar baz\n",
+ ' ',
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar baz</Verbatim></Document>},
+ "<pre><code>foo bar baz</code></pre>\n\n",
+ 'single space indent'
+ ],
+ [
+ "\n=pod\n\n foo bar baz\n",
+ ' ',
+ qq{<Document><Verbatim\nxml:space="preserve"> foo bar baz</Verbatim></Document>},
+ "<pre><code> foo bar baz</code></pre>\n\n",
+ 'too large indent'
+ ],
+ [
+ "\n=pod\n\n foo bar baz\n",
+ ' ',
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar baz</Verbatim></Document>},
+ "<pre><code>foo bar baz</code></pre>\n\n",
+ 'double space indent'
+ ],
+ [
+ "\n=pod\n\n foo bar baz\n",
+ sub { ' ' },
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar baz</Verbatim></Document>},
+ "<pre><code>foo bar baz</code></pre>\n\n",
+ 'code ref stripper'
+ ],
+ [
+ "\n=pod\n\n foo bar\n\n baz blez\n",
+ ' ',
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar\n\nbaz blez</Verbatim></Document>},
+ "<pre><code>foo bar\n\nbaz blez</code></pre>\n\n",
+ 'single space indent and empty line'
+ ],
+ [
+ "\n=pod\n\n foo bar\n\n baz blez\n",
+ sub { ' ' },
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar\n\nbaz blez</Verbatim></Document>},
+ "<pre><code>foo bar\n\nbaz blez</code></pre>\n\n",
+ 'code ref indent and empty line'
+ ],
+ [
+ "\n=pod\n\n foo bar\n\n baz blez\n",
+ sub { (my $s = shift->[0]) =~ s/\S.*//; $s },
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar\n\nbaz blez</Verbatim></Document>},
+ "<pre><code>foo bar\n\nbaz blez</code></pre>\n\n",
+ 'heuristic code ref indent'
+ ],
+ [
+ "\n=pod\n\n foo bar\n baz blez\n",
+ sub { s/^\s+// for @{ $_[0] } },
+ qq{<Document><Verbatim\nxml:space="preserve">foo bar\nbaz blez</Verbatim></Document>},
+ "<pre><code>foo bar\nbaz blez</code></pre>\n\n",
+ 'militant code ref'
+ ],
+) {
+ my ($pod, $indent, $xml, $xhtml, $desc) = @$spec;
+ # Test XML output.
+ ok my $p = Pod::Simple::XMLOutStream->new, "Construct XML parser to test $desc";
+ $p->hide_line_numbers(1);
+ my $output = '';
+ $p->output_string( \$output );
+ is $indent, $p->strip_verbatim_indent($indent),
+ 'Set stripper for XML to ' . (defined $indent ? qq{"$indent"} : 'undef');
+ ok $p->parse_string_document( $pod ), "Parse POD to XML for $desc";
+ is $output, $xml, "Should have expected XML output for $desc";
+
+
+ # Test XHTML output.
+ ok $p = Pod::Simple::XHTML->new, "Construct XHMTL parser to test $desc";
+ $p->html_header('');
+ $p->html_footer('');
+ $output = '';
+ $p->output_string( \$output );
+ is $indent, $p->strip_verbatim_indent($indent),
+ 'Set stripper for XHTML to ' . (defined $indent ? qq{"$indent"} : 'undef');
+ ok $p->parse_string_document( $pod ), "Parse POD to XHTML for $desc";
+ is $output, $xhtml, "Should have expected XHTML output for $desc";
+}
diff --git a/cpan/Pod-Simple/t/xhtml01.t b/cpan/Pod-Simple/t/xhtml01.t
index d75605a..d272390 100644
--- a/cpan/Pod-Simple/t/xhtml01.t
+++ b/cpan/Pod-Simple/t/xhtml01.t
@@ -8,7 +8,7 @@ BEGIN {
use strict;
use lib '../lib';
-use Test::More tests => 26;
+use Test::More tests => 33;
use_ok('Pod::Simple::XHTML') or exit;
@@ -21,19 +21,19 @@ my $PERLDOC = "http://search.cpan.org/perldoc?";
initialize($parser, $results);
$parser->parse_string_document( "=head1 Poit!" );
-is($results, "<h1>Poit!</h1>\n\n", "head1 level output");
+is($results, qq{<h1 id="Poit-">Poit!</h1>\n\n}, "head1 level output");
initialize($parser, $results);
$parser->parse_string_document( "=head2 I think so Brain." );
-is($results, "<h2>I think so Brain.</h2>\n\n", "head2 level output");
+is($results, qq{<h2 id="I-think-so-Brain.">I think so Brain.</h2>\n\n}, "head2 level output");
initialize($parser, $results);
$parser->parse_string_document( "=head3 I say, Brain..." );
-is($results, "<h3>I say, Brain...</h3>\n\n", "head3 level output");
+is($results, qq{<h3 id="I-say-Brain...">I say, Brain...</h3>\n\n}, "head3 level output");
initialize($parser, $results);
-$parser->parse_string_document( "=head4 Zort!" );
-is($results, "<h4>Zort!</h4>\n\n", "head4 level output");
+$parser->parse_string_document( "=head4 Zort & Zog!" );
+is($results, qq{<h4 id="Zort-Zog-">Zort & Zog!</h4>\n\n}, "head4 level output");
initialize($parser, $results);
@@ -63,7 +63,7 @@ EOPOD
is($results, <<'EOHTML', "multiple paragraphs");
<p>B: Now, Pinky, if by any chance you are captured during this mission, remember you are Gunther Heindriksen from Appenzell. You moved to Grindelwald to drive the cog train to Murren. Can you repeat that?</p>
-<p>P: Mmmm, no, Brain, don't think I can.</p>
+<p>P: Mmmm, no, Brain, don't think I can.</p>
EOHTML
@@ -86,10 +86,12 @@ EOPOD
is($results, <<'EOHTML', "simple bulleted list");
<ul>
-<li>P: Gee, Brain, what do you want to do tonight?</li>
+<li><p>P: Gee, Brain, what do you want to do tonight?</p>
-<li>B: The same thing we do every night, Pinky. Try to take over the world!</li>
+</li>
+<li><p>B: The same thing we do every night, Pinky. Try to take over the world!</p>
+</li>
</ul>
EOHTML
@@ -114,10 +116,12 @@ EOPOD
is($results, <<'EOHTML', "numbered list");
<ol>
-<li>1. P: Gee, Brain, what do you want to do tonight?</li>
+<li><p>P: Gee, Brain, what do you want to do tonight?</p>
-<li>2. B: The same thing we do every night, Pinky. Try to take over the world!</li>
+</li>
+<li><p>B: The same thing we do every night, Pinky. Try to take over the world!</p>
+</li>
</ol>
EOHTML
@@ -140,16 +144,78 @@ The same thing we do every night, Pinky. Try to take over the world!
EOPOD
is($results, <<'EOHTML', "list with text headings");
+<dl>
+
+<dt>Pinky</dt>
+<dd>
+
+<p>Gee, Brain, what do you want to do tonight?</p>
+
+</dd>
+<dt>Brain</dt>
+<dd>
+
+<p>The same thing we do every night, Pinky. Try to take over the world!</p>
+
+</dd>
+</dl>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=over
+
+=item * Pinky
+
+Gee, Brain, what do you want to do tonight?
+
+=item * Brain
+
+The same thing we do every night, Pinky. Try to take over the world!
+
+=back
+
+EOPOD
+
+is($results, <<'EOHTML', "list with bullet and text headings");
<ul>
-<li>Pinky
+<li><p>Pinky</p>
<p>Gee, Brain, what do you want to do tonight?</p>
-<li>Brain
+</li>
+<li><p>Brain</p>
<p>The same thing we do every night, Pinky. Try to take over the world!</p>
+</li>
+</ul>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=over
+
+=item * Brain <[email protected]>
+
+=item * Pinky <[email protected]>
+
+=back
+
+EOPOD
+
+is($results, <<'EOHTML', "bulleted author list");
+<ul>
+
+<li><p>Brain <[email protected]></p>
+
+</li>
+<li><p>Pinky <[email protected]></p>
+
+</li>
</ul>
EOHTML
@@ -245,7 +311,7 @@ $parser->parse_string_document(<<'EOPOD');
A plain paragraph with a L<perlport/Newlines>.
EOPOD
is($results, <<"EOHTML", "Link entity in a paragraph");
-<p>A plain paragraph with a <a href="${PERLDOC}perlport/Newlines">"Newlines" in perlport</a>.</p>
+<p>A plain paragraph with a <a href="${PERLDOC}perlport/Newlines">"Newlines" in perlport</a>.</p>
EOHTML
@@ -304,20 +370,44 @@ is($results, <<"EOHTML", "File name in a paragraph");
EOHTML
-
+# It's not important that 's (apostrophes) be encoded for XHTML output.
initialize($parser, $results);
$parser->parse_string_document(<<'EOPOD');
=pod
- # this header is very important & don't you forget it
+ # this header is very important & dont you forget it
my $text = "File is: " . <FILE>;
EOPOD
is($results, <<"EOHTML", "Verbatim text with encodable entities");
-<pre><code> # this header is very important & don't you forget it
+<pre><code> # this header is very important & dont you forget it
my \$text = "File is: " . <FILE>;</code></pre>
EOHTML
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A text paragraph using E<sol> and E<verbar> special POD entities.
+
+EOPOD
+is($results, <<"EOHTML", "Text with decodable entities");
+<p>A text paragraph using / and | special POD entities.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A text paragraph using numeric POD entities: E<60>, E<62>.
+
+EOPOD
+is($results, <<"EOHTML", "Text with numeric entities");
+<p>A text paragraph using numeric POD entities: <, >.</p>
+
+EOHTML
+
SKIP: for my $use_html_entities (0, 1) {
if ($use_html_entities and not $Pod::Simple::XHTML::HAS_HTML_ENTITIES) {
skip("HTML::Entities not installed", 1);
@@ -327,18 +417,26 @@ SKIP: for my $use_html_entities (0, 1) {
$parser->parse_string_document(<<'EOPOD');
=pod
- # this header is very important & don't you forget it
+ # this header is very important & dont you forget it
B<my $file = <FILEE<gt> || 'Blank!';>
my $text = "File is: " . <FILE>;
EOPOD
is($results, <<"EOHTML", "Verbatim text with markup and embedded formatting");
-<pre><code> # this header is very important & don't you forget it
+<pre><code> # this header is very important & dont you forget it
<b>my \$file = <FILE> || 'Blank!';</b>
my \$text = "File is: " . <FILE>;</code></pre>
EOHTML
}
+
+ok $parser = Pod::Simple::XHTML->new, 'Construct a new parser';
+$results = '';
+$parser->output_string( \$results ); # Send the resulting output to a string
+ok $parser->parse_string_document( "=head1 Poit!" ), 'Parse with headers';
+like $results, qr{<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />},
+ 'Should have proper http-equiv meta tag';
+
######################################
sub initialize {
diff --git a/cpan/Pod-Simple/t/xhtml10.t b/cpan/Pod-Simple/t/xhtml10.t
new file mode 100644
index 0000000..c3ec202
--- /dev/null
+++ b/cpan/Pod-Simple/t/xhtml10.t
@@ -0,0 +1,408 @@
+#!/usr/bin/perl -w
+
+# t/xhtml01.t - check basic output from Pod::Simple::XHTML
+
+BEGIN {
+ chdir 't' if -d 't';
+}
+
+use strict;
+use lib '../lib';
+use Test::More tests => 44;
+#use Test::More 'no_plan';
+
+use_ok('Pod::Simple::XHTML') or exit;
+
+isa_ok my $parser = Pod::Simple::XHTML->new, 'Pod::Simple::XHTML';
+my $header = $parser->html_header;
+my $footer = $parser->html_footer;
+
+for my $spec (
+ [ 'foo' => 'foo', 'foo' ],
+ [ '12foo' => 'foo1', 'foo' ],
+ [ 'fo$bar' => 'fo-bar', 'fo-bar' ],
+ [ 'f12' => 'f12', 'f12' ],
+ [ '13' => 'pod13', 'pod13' ],
+ [ '**.:' => 'pod-.:', 'pod-.:' ],
+) {
+ is $parser->idify( $spec->[0] ), $spec->[1],
+ qq{ID for "$spec->[0]" should be "$spec->[1]"};
+ is $parser->idify( $spec->[0], 1 ), $spec->[2],
+ qq{Non-unique ID for "$spec->[0]" should be "$spec->[2]"};
+}
+
+my $results;
+
+initialize($parser, $results);
+$parser->html_header($header);
+$parser->html_footer($footer);
+ok $parser->parse_string_document( '=head1 Foo' ), 'Parse one header';
+is $results, <<'EOF', 'Should have the index';
+
+<html>
+<head>
+<title></title>
+<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
+</head>
+<body>
+
+
+<ul id="index">
+ <li><a href="#Foo">Foo</a></li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+</body>
+</html>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( '=head1 Foo Bar' ), 'Parse multiword header';
+is $results, <<'EOF', 'Should have the index';
+<ul id="index">
+ <li><a href="#Foo-Bar">Foo Bar</a></li>
+</ul>
+
+<h1 id="Foo-Bar">Foo Bar</h1>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo B<Bar>\n\n=head1 Foo B<Baz>" ),
+ 'Parse two multiword headers';
+is $results, <<'EOF', 'Should have the index';
+<ul id="index">
+ <li><a href="#Foo-Bar">Foo <b>Bar</b></a></li>
+ <li><a href="#Foo-Baz">Foo <b>Baz</b></a></li>
+</ul>
+
+<h1 id="Foo-Bar">Foo <b>Bar</b></h1>
+
+<h1 id="Foo-Baz">Foo <b>Baz</b></h1>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head1 Bar" ), 'Parse two headers';
+is $results, <<'EOF', 'Should have both and the index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a></li>
+ <li><a href="#Bar">Bar</a></li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h1 id="Bar">Bar</h1>
+
+EOF
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head1 Bar\n\n=head1 Baz" ),
+ 'Parse three headers';
+is $results, <<'EOF', 'Should have all three and the index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a></li>
+ <li><a href="#Bar">Bar</a></li>
+ <li><a href="#Baz">Baz</a></li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h1 id="Bar">Bar</h1>
+
+<h1 id="Baz">Baz</h1>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar" ), 'Parse two levels';
+is $results, <<'EOF', 'Should have the dual-level index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li><a href="#Bar">Bar</a></li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h2 id="Bar">Bar</h2>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head3 Baz" ),
+ 'Parse three levels';
+is $results, <<'EOF', 'Should have the three-level index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li><a href="#Bar">Bar</a>
+ <ul>
+ <li><a href="#Baz">Baz</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h2 id="Bar">Bar</h2>
+
+<h3 id="Baz">Baz</h3>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head3 Baz\n\n=head4 Howdy" ),
+ 'Parse four levels';
+is $results, <<'EOF', 'Should have the four-level index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li><a href="#Bar">Bar</a>
+ <ul>
+ <li><a href="#Baz">Baz</a>
+ <ul>
+ <li><a href="#Howdy">Howdy</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h2 id="Bar">Bar</h2>
+
+<h3 id="Baz">Baz</h3>
+
+<h4 id="Howdy">Howdy</h4>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head2 Baz" ),
+ 'Parse 1/2';
+is $results, <<'EOF', 'Should have the 1/s index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li><a href="#Bar">Bar</a></li>
+ <li><a href="#Baz">Baz</a></li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h2 id="Bar">Bar</h2>
+
+<h2 id="Baz">Baz</h2>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head3 Bar" ), 'Parse jump from one to three';
+is $results, <<'EOF', 'Should have the 1-3 index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li>
+ <ul>
+ <li><a href="#Bar">Bar</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h3 id="Bar">Bar</h3>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo\n\n=head4 Bar" ), 'Parse jump from one to four';
+is $results, <<'EOF', 'Should have the 1-4 index';
+<ul id="index">
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li>
+ <ul>
+ <li>
+ <ul>
+ <li><a href="#Bar">Bar</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h1 id="Foo">Foo</h1>
+
+<h4 id="Bar">Bar</h4>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head2 Foo\n\n=head1 Bar" ),
+ 'Parse two down to 1';
+is $results, <<'EOF', 'Should have the 2-1 index';
+<ul id="index">
+ <li>
+ <ul>
+ <li><a href="#Foo">Foo</a></li>
+ </ul>
+ </li>
+ <li><a href="#Bar">Bar</a></li>
+</ul>
+
+<h2 id="Foo">Foo</h2>
+
+<h1 id="Bar">Bar</h1>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head2 Foo\n\n=head1 Bar\n\n=head4 Four\n\n=head4 Four2" ),
+ 'Parse two down to 1';
+is $results, <<'EOF', 'Should have the 2-1 index';
+<ul id="index">
+ <li>
+ <ul>
+ <li><a href="#Foo">Foo</a></li>
+ </ul>
+ </li>
+ <li><a href="#Bar">Bar</a>
+ <ul>
+ <li>
+ <ul>
+ <li>
+ <ul>
+ <li><a href="#Four">Four</a></li>
+ <li><a href="#Four2">Four2</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h2 id="Foo">Foo</h2>
+
+<h1 id="Bar">Bar</h1>
+
+<h4 id="Four">Four</h4>
+
+<h4 id="Four2">Four2</h4>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head4 Foo" ),
+ 'Parse just a four';
+is $results, <<'EOF', 'Should have the 2-1 index';
+<ul id="index">
+ <li>
+ <ul>
+ <li>
+ <ul>
+ <li>
+ <ul>
+ <li><a href="#Foo">Foo</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+</ul>
+
+<h4 id="Foo">Foo</h4>
+
+EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( <<'EOF' ), 'Parse a mixture';
+=head2 Foo
+
+=head3 Bar
+
+=head1 Baz
+
+=head4 Drink
+
+=head3 Sip
+
+=head4 Ouch
+
+=head1 Drip
+EOF
+
+is $results, <<'EOF', 'And it should work!';
+<ul id="index">
+ <li>
+ <ul>
+ <li><a href="#Foo">Foo</a>
+ <ul>
+ <li><a href="#Bar">Bar</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ <li><a href="#Baz">Baz</a>
+ <ul>
+ <li>
+ <ul>
+ <li>
+ <ul>
+ <li><a href="#Drink">Drink</a></li>
+ </ul>
+ </li>
+ <li><a href="#Sip">Sip</a>
+ <ul>
+ <li><a href="#Ouch">Ouch</a></li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ </ul>
+ </li>
+ <li><a href="#Drip">Drip</a></li>
+</ul>
+
+<h2 id="Foo">Foo</h2>
+
+<h3 id="Bar">Bar</h3>
+
+<h1 id="Baz">Baz</h1>
+
+<h4 id="Drink">Drink</h4>
+
+<h3 id="Sip">Sip</h3>
+
+<h4 id="Ouch">Ouch</h4>
+
+<h1 id="Drip">Drip</h1>
+
+EOF
+
+sub initialize {
+ $_[0] = Pod::Simple::XHTML->new;
+ $_[0]->html_header('');
+ $_[0]->html_footer('');
+ $_[0]->index(1);
+ $_[0]->output_string( \$results ); # Send the resulting output to a string
+ $_[1] = '';
+ return;
+}
--
1.6.4
1.6.4
