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