diff -up perl-5.10.0/lib/Pod/Simple/BlackBox.pm.old perl-5.10.0/lib/Pod/Simple/BlackBox.pm --- perl-5.10.0/lib/Pod/Simple/BlackBox.pm.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/BlackBox.pm 2008-06-03 17:08:18.000000000 +0200 @@ -910,17 +910,10 @@ sub _ponder_begin { return 1; } - unless($content =~ m/^\S+$/s) { # i.e., unless it's one word - $self->whine( - $para->[1]{'start_line'}, - "'=begin' only takes one parameter, not several as in '=begin $content'" - ); - DEBUG and print "Ignoring unintelligible =begin $content\n"; - return 1; - } - - - $para->[1]{'target'} = $content; # without any ':' + my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/; + $para->[1]{'title'} = $title if ($title); + $para->[1]{'target'} = $target; # without any ':' + $content = $target; # strip off the title $content =~ s/^:!/!:/s; my $neg; # whether this is a negation-match @@ -1681,8 +1674,11 @@ sub _treelet_from_formatting_codes { [A-Z](?!<) ) | + # whitespace is ok, but we don't want to eat the whitespace before + # a multiple-bracket end code. + # NOTE: we may still have problems with e.g. S<< >> (?: - \s(?!\s*>) + \s(?!\s*>{2,}) ) )+ ) diff -U0 perl-5.10.0/lib/Pod/Simple/ChangeLog.old perl-5.10.0/lib/Pod/Simple/ChangeLog diff -up perl-5.10.0/lib/Pod/Simple/Checker.pm.old perl-5.10.0/lib/Pod/Simple/Checker.pm diff -up perl-5.10.0/lib/Pod/Simple/Debug.pm.old perl-5.10.0/lib/Pod/Simple/Debug.pm diff -up perl-5.10.0/lib/Pod/Simple/DumpAsText.pm.old perl-5.10.0/lib/Pod/Simple/DumpAsText.pm diff -up perl-5.10.0/lib/Pod/Simple/DumpAsXML.pm.old perl-5.10.0/lib/Pod/Simple/DumpAsXML.pm diff -up perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm.old perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm --- perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm 2008-05-29 19:33:26.000000000 +0200 @@ -607,7 +607,7 @@ sub _spray_css { my $url = $chunk->[0]; my $outfile; if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) { - $outfile = $self->filespecsys->catfile( $outdir, $1 ); + $outfile = $self->filespecsys->catfile( $outdir, "$1" ); DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n"; } else { DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n"; @@ -772,7 +772,7 @@ sub _spray_javascript { my $outfile; if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) { - $outfile = $self->filespecsys->catfile( $outdir, $1 ); + $outfile = $self->filespecsys->catfile( $outdir, "$1" ); DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n"; } else { DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n"; diff -up perl-5.10.0/lib/Pod/Simple/HTMLLegacy.pm.old perl-5.10.0/lib/Pod/Simple/HTMLLegacy.pm diff -up perl-5.10.0/lib/Pod/Simple/HTML.pm.old perl-5.10.0/lib/Pod/Simple/HTML.pm --- perl-5.10.0/lib/Pod/Simple/HTML.pm.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/HTML.pm 2008-05-29 19:33:26.000000000 +0200 @@ -164,7 +164,7 @@ sub changes2 { } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -sub go { exit Pod::Simple::HTML->parse_from_file(@ARGV) } +sub go { Pod::Simple::HTML->parse_from_file(@ARGV); exit 0 } # Just so we can run from the command line. No options. # For that, use perldoc! #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff -up perl-5.10.0/lib/Pod/Simple/LinkSection.pm.old perl-5.10.0/lib/Pod/Simple/LinkSection.pm diff -up perl-5.10.0/lib/Pod/Simple/Methody.pm.old perl-5.10.0/lib/Pod/Simple/Methody.pm diff -up perl-5.10.0/lib/Pod/Simple.pm.old perl-5.10.0/lib/Pod/Simple.pm --- perl-5.10.0/lib/Pod/Simple.pm.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple.pm 2008-06-05 00:04:27.000000000 +0200 @@ -18,7 +18,7 @@ use vars qw( ); @ISA = ('Pod::Simple::BlackBox'); -$VERSION = '3.05'; +$VERSION = '3.07'; @Known_formatting_codes = qw(I B C L E F S X Z); %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); @@ -983,6 +983,7 @@ sub _treat_Ls { # Process our dear dear # L or L # L or L or L # L + # Ltext|scheme:...> my($self,@stack) = @_; @@ -1002,11 +1003,12 @@ sub _treat_Ls { # Process our dear dear # By here, $treelet->[$i] is definitely an L node - DEBUG > 1 and print "Ogling L node $treelet->[$i]\n"; + my $ell = $treelet->[$i]; + DEBUG > 1 and print "Ogling L node $ell\n"; # bitch if it's empty - if( @{$treelet->[$i]} == 2 - or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') + if( @{$ell} == 2 + or (@{$ell} == 3 and $ell->[2] eq '') ) { $self->whine( $start_line, "An empty L<>" ); $treelet->[$i] = 'L<>'; # just make it a text node @@ -1014,55 +1016,70 @@ sub _treat_Ls { # Process our dear dear } # Catch URLs: - # URLs can, alas, contain E<...> sequences, so we can't /assume/ - # that this is one text node. But it has to START with one text - # node... - if(! ref $treelet->[$i][2] and - $treelet->[$i][2] =~ m/^\w+:[^:\s]\S*$/s + + # there are a number of possible cases: + # 1) text node containing url: http://foo.com + # -> [ 'http://foo.com' ] + # 2) text node containing url and text: foo|http://foo.com + # -> [ 'foo|http://foo.com' ] + # 3) text node containing url start: mailto:xEfoo.com + # -> [ 'mailto:x', [ E ... ], 'foo.com' ] + # 4) text node containing url start and text: foo|mailto:xEfoo.com + # -> [ 'foo|mailto:x', [ E ... ], 'foo.com' ] + # 5) other nodes containing text and url start: OE<39>Malley|http://foo.com + # -> [ 'O', [ E ... ], 'Malley', '|http://foo.com' ] + # ... etc. + + # anything before the url is part of the text. + # anything after it is part of the url. + # the url text node itself may contain parts of both. + + if (my ($url_index, $text_part, $url_part) = + # grep is no good here; we want to bail out immediately so that we can + # use $1, $2, etc. without having to do the match twice. + sub { + for (2..$#$ell) { + next if ref $ell->[$_]; + next unless $ell->[$_] =~ m/^(?:([^|]*)\|)?(\w+:[^:\s]\S*)$/s; + return ($_, $1, $2); + } + return; + }->() ) { - $treelet->[$i][1]{'type'} = 'url'; - $treelet->[$i][1]{'content-implicit'} = 'yes'; + $ell->[1]{'type'} = 'url'; - # TODO: deal with rel: URLs here? + my @text = @{$ell}[2..$url_index-1]; + push @text, $text_part if defined $text_part; - if( 3 == @{ $treelet->[$i] } ) { - # But if it IS just one text node (most common case) - DEBUG > 1 and printf qq{Catching "%s as " as ho-hum L link.\n}, - $treelet->[$i][2] - ; - $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new( - $treelet->[$i][2] - ); # its own treelet - } else { - # It's a URL but complex (like "Lbar>"). Feh. - #$treelet->[$i][1]{'to'} = [ @{$treelet->[$i]} ]; - #splice @{ $treelet->[$i][1]{'to'} }, 0,2; - #DEBUG > 1 and printf qq{Catching "%s as " as complex L link.\n}, - # join '~', @{$treelet->[$i][1]{'to' }}; - - $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new( - $treelet->[$i] # yes, clone the whole content as a treelet - ); - $treelet->[$i][1]{'to'}[0] = ''; # set the copy's tagname to nil - die "SANITY FAILURE" if $treelet->[0] eq ''; # should never happen! - DEBUG > 1 and print - qq{Catching "$treelet->[$i][1]{'to'}" as a complex L link.\n}; + my @url = @{$ell}[$url_index+1..$#$ell]; + unshift @url, $url_part; + + unless (@text) { + $ell->[1]{'content-implicit'} = 'yes'; + @text = @url; } - next; # and move on + $ell->[1]{to} = Pod::Simple::LinkSection->new( + @url == 1 + ? $url[0] + : [ '', {}, @url ], + ); + + splice @$ell, 2, $#$ell, @text; + + next; } - # Catch some very simple and/or common cases - if(@{$treelet->[$i]} == 3 and ! ref $treelet->[$i][2]) { - my $it = $treelet->[$i][2]; + if(@{$ell} == 3 and ! ref $ell->[2]) { + my $it = $ell->[2]; if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections # Hopefully neither too broad nor too restrictive a RE DEBUG > 1 and print "Catching \"$it\" as manpage link.\n"; - $treelet->[$i][1]{'type'} = 'man'; + $ell->[1]{'type'} = 'man'; # This's the only place where man links can get made. - $treelet->[$i][1]{'content-implicit'} = 'yes'; - $treelet->[$i][1]{'to' } = + $ell->[1]{'content-implicit'} = 'yes'; + $ell->[1]{'to' } = Pod::Simple::LinkSection->new( $it ); # treelet! next; @@ -1071,9 +1088,9 @@ sub _treat_Ls { # Process our dear dear # Extremely forgiving idea of what constitutes a bare # modulename link like L or even L DEBUG > 1 and print "Catching \"$it\" as ho-hum L link.\n"; - $treelet->[$i][1]{'type'} = 'pod'; - $treelet->[$i][1]{'content-implicit'} = 'yes'; - $treelet->[$i][1]{'to' } = + $ell->[1]{'type'} = 'pod'; + $ell->[1]{'content-implicit'} = 'yes'; + $ell->[1]{'to' } = Pod::Simple::LinkSection->new( $it ); # treelet! next; } @@ -1089,7 +1106,6 @@ sub _treat_Ls { # Process our dear dear my $link_text; # set to an arrayref if found - my $ell = $treelet->[$i]; my @ell_content = @$ell; splice @ell_content,0,2; # Knock off the 'L' and {} bits @@ -1443,7 +1459,7 @@ sub _out { "\nAbout to parse source: {{\n$_[0]\n}}\n\n"; - my $parser = $class->new; + my $parser = ref $class && $class->isa(__PACKAGE__) ? $class : $class->new; $parser->hide_line_numbers(1); my $out = ''; diff -up perl-5.10.0/lib/Pod/Simple.pod.old perl-5.10.0/lib/Pod/Simple.pod --- perl-5.10.0/lib/Pod/Simple.pod.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple.pod 2008-06-03 15:27:24.000000000 +0200 @@ -211,7 +211,15 @@ merchantability or fitness for a particu Original author: Sean M. Burke C -Maintained by: Allison Randal C +Maintained by: + +=over + +=item * Allison Randal C + +=item * Hans Dieter Pearcey C + +=back =cut diff -urN perl-5.10.0/lib/Pod/Simple/t.old/accept05.t perl-5.10.0/lib/Pod/Simple/t/accept05.t --- perl-5.10.0/lib/Pod/Simple/t.old/accept05.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/accept05.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# Testing extend and accept_codes BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/corpus.t perl-5.10.0/lib/Pod/Simple/t/corpus.t --- perl-5.10.0/lib/Pod/Simple/t.old/corpus.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/corpus.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# Testing a corpus of Pod files BEGIN { if($ENV{PERL_CORE}) { chdir 't'; @@ -128,9 +129,7 @@ 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 -urN perl-5.10.0/lib/Pod/Simple/t.old/encod01.t perl-5.10.0/lib/Pod/Simple/t/encod01.t --- perl-5.10.0/lib/Pod/Simple/t.old/encod01.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/encod01.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# encoding nonesuch BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/encod02.t perl-5.10.0/lib/Pod/Simple/t/encod02.t --- perl-5.10.0/lib/Pod/Simple/t.old/encod02.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/encod02.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# encoding not error BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/encod03.t perl-5.10.0/lib/Pod/Simple/t/encod03.t --- perl-5.10.0/lib/Pod/Simple/t.old/encod03.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/encod03.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# encoding not error 0 BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/end_over.t perl-5.10.0/lib/Pod/Simple/t/end_over.t --- perl-5.10.0/lib/Pod/Simple/t.old/end_over.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/end_over.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# head ends over BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/fcodes_e.t perl-5.10.0/lib/Pod/Simple/t/fcodes_e.t --- perl-5.10.0/lib/Pod/Simple/t.old/fcodes_e.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/fcodes_e.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# fcodes E BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/fcodes_l.t perl-5.10.0/lib/Pod/Simple/t/fcodes_l.t --- perl-5.10.0/lib/Pod/Simple/t.old/fcodes_l.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/fcodes_l.t 2008-06-03 15:27:24.000000000 +0200 @@ -1,3 +1,4 @@ +# fcodes L BEGIN { if($ENV{PERL_CORE}) { chdir 't'; @@ -7,7 +8,7 @@ use strict; use Test; -BEGIN { plan tests => 93 }; +BEGIN { plan tests => 99 }; #use Pod::Simple::Debug (10); @@ -398,6 +399,27 @@ 'I like the various attributes.' ); +ok( $x->_out(qq{=pod\n\nI like L<<< Bs|http://text.com >>>.\n}), +'I like texts.' +); +ok( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}), +'I like text.' +); +ok( $x->_out(qq{=pod\n\nI like L<<< I|http://text.com >>>.\n}), +'I like text.' +); +ok( $x->_out(qq{=pod\n\nI like L<<< C|http://text.com >>>.\n}), +'I like text.' +); +ok( $x->_out(qq{=pod\n\nI like L<<< I>>>|mailto:earlE<64>text.com >>>.\n}), +'I like text.' +); +ok( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}), +'I like text.' +); + + + # # TODO: S testing. diff -urN perl-5.10.0/lib/Pod/Simple/t.old/fcodes_s.t perl-5.10.0/lib/Pod/Simple/t/fcodes_s.t --- perl-5.10.0/lib/Pod/Simple/t.old/fcodes_s.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/fcodes_s.t 2008-06-03 15:27:24.000000000 +0200 @@ -1,3 +1,4 @@ +# fcodes S BEGIN { if($ENV{PERL_CORE}) { chdir 't'; @@ -7,7 +8,7 @@ use strict; use Test; -BEGIN { plan tests => 13 }; +BEGIN { plan tests => 14 }; #use Pod::Simple::Debug (6); @@ -76,7 +77,30 @@ qq{=pod\n\nI like LIthat>|"bric-a-brac a gogo">.\n}, )); +use Pod::Simple::Text; +$x = Pod::Simple::Text->new; +$x->preserve_whitespace(1); +# RT#25679 +ok( + $x->_out(< E foo >> is being rendered +Both pod2text and pod2man S< > lose the rest of the line + +=head1 Do they always S< > lose the rest of the line? + +=cut +END + ), + < foo is being rendered + + Both pod2text and pod2man lose the rest of the line + +Do they always lose the rest of the line? + +END +); print "# Wrapping up... one for the road...\n"; ok 1; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/fullstop.t perl-5.10.0/lib/Pod/Simple/t/fullstop.t --- perl-5.10.0/lib/Pod/Simple/t.old/fullstop.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/fullstop.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# Testing hardening fullstop spaces BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/html01.t perl-5.10.0/lib/Pod/Simple/t/html01.t --- perl-5.10.0/lib/Pod/Simple/t.old/html01.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/html01.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,4 +1,4 @@ -# t/html-para.t +# Testing HTML paragraphs BEGIN { if($ENV{PERL_CORE}) { diff -urN perl-5.10.0/lib/Pod/Simple/t.old/html02.t perl-5.10.0/lib/Pod/Simple/t/html02.t --- perl-5.10.0/lib/Pod/Simple/t.old/html02.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/html02.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,4 +1,4 @@ -# t/html-styles.t +# Testing HTML text styles BEGIN { if($ENV{PERL_CORE}) { diff -urN perl-5.10.0/lib/Pod/Simple/t.old/html03.t perl-5.10.0/lib/Pod/Simple/t/html03.t --- perl-5.10.0/lib/Pod/Simple/t.old/html03.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/html03.t 2008-06-03 17:10:07.000000000 +0200 @@ -1,4 +1,4 @@ -# t/html-para.t +# Testing HTML titles BEGIN { if($ENV{PERL_CORE}) { diff -urN perl-5.10.0/lib/Pod/Simple/t.old/items02.t perl-5.10.0/lib/Pod/Simple/t/items02.t --- perl-5.10.0/lib/Pod/Simple/t.old/items02.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/items02.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,44 +1,44 @@ -#!perl -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"), - '5Stuff4Quux' -); - -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"), - '5.Stuff4.Quux' -); - - -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"), + '5Stuff4Quux' +); + +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"), + '5.Stuff4.Quux' +); + + +print "# Wrapping up... one for the road...\n"; +ok 1; +print "# --- Done with ", __FILE__, " --- \n"; + diff -urN perl-5.10.0/lib/Pod/Simple/t.old/linkclas.t perl-5.10.0/lib/Pod/Simple/t/linkclas.t --- perl-5.10.0/lib/Pod/Simple/t.old/linkclas.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/linkclas.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# Testing the LinkSection class BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/search20.t perl-5.10.0/lib/Pod/Simple/t/search20.t --- perl-5.10.0/lib/Pod/Simple/t.old/search20.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/search20.t 2007-09-02 08:21:41.000000000 +0200 @@ -69,16 +69,12 @@ { 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 -urN perl-5.10.0/lib/Pod/Simple/t.old/search22.t perl-5.10.0/lib/Pod/Simple/t/search22.t --- perl-5.10.0/lib/Pod/Simple/t.old/search22.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/search22.t 2007-09-02 08:21:41.000000000 +0200 @@ -71,17 +71,13 @@ { 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 -urN perl-5.10.0/lib/Pod/Simple/t.old/search50.t perl-5.10.0/lib/Pod/Simple/t/search50.t --- perl-5.10.0/lib/Pod/Simple/t.old/search50.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/search50.t 2007-09-02 08:21:41.000000000 +0200 @@ -11,7 +11,7 @@ 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 @@ 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 @@ 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/.pm' means can't test find() } ok 1; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/testlib2/squaa/Wowo.pod perl-5.10.0/lib/Pod/Simple/t/testlib2/squaa/Wowo.pod --- perl-5.10.0/lib/Pod/Simple/t.old/testlib2/squaa/Wowo.pod 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/testlib2/squaa/Wowo.pod 2007-09-02 08:21:35.000000000 +0200 @@ -1,7 +1,7 @@ =head1 NAME -squaa::Wowo -- blorpoesu +squaa::Glunk -- blorpoesu =head1 DESCRIPTION diff -urN perl-5.10.0/lib/Pod/Simple/t.old/tiedfh.t perl-5.10.0/lib/Pod/Simple/t/tiedfh.t --- perl-5.10.0/lib/Pod/Simple/t.old/tiedfh.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/tiedfh.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,3 +1,4 @@ +# Testing tied output filehandle BEGIN { if($ENV{PERL_CORE}) { chdir 't'; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/verbatim.t perl-5.10.0/lib/Pod/Simple/t/verbatim.t --- perl-5.10.0/lib/Pod/Simple/t.old/verbatim.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/verbatim.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,4 +1,4 @@ - +# Testing verbatim sections use strict; use Test; BEGIN { plan tests => 31 }; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/verb_fmt.t perl-5.10.0/lib/Pod/Simple/t/verb_fmt.t --- perl-5.10.0/lib/Pod/Simple/t.old/verb_fmt.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/verb_fmt.t 2007-09-02 08:21:41.000000000 +0200 @@ -1,4 +1,4 @@ - +# Testing verbatim formatted sections use strict; use Test; BEGIN { plan tests => 62 }; diff -urN perl-5.10.0/lib/Pod/Simple/t.old/xhtml01.t perl-5.10.0/lib/Pod/Simple/t/xhtml01.t --- perl-5.10.0/lib/Pod/Simple/t.old/xhtml01.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/xhtml01.t 2008-06-05 00:06:00.000000000 +0200 @@ -0,0 +1,351 @@ +#!/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 => 26; + +use_ok('Pod::Simple::XHTML') or exit; + +my $parser = Pod::Simple::XHTML->new (); +isa_ok ($parser, 'Pod::Simple::XHTML'); + +my $results; + +my $PERLDOC = "http://search.cpan.org/perldoc?"; + +initialize($parser, $results); +$parser->parse_string_document( "=head1 Poit!" ); +is($results, "

Poit!

\n\n", "head1 level output"); + +initialize($parser, $results); +$parser->parse_string_document( "=head2 I think so Brain." ); +is($results, "

I think so Brain.

\n\n", "head2 level output"); + +initialize($parser, $results); +$parser->parse_string_document( "=head3 I say, Brain..." ); +is($results, "

I say, Brain...

\n\n", "head3 level output"); + +initialize($parser, $results); +$parser->parse_string_document( "=head4 Zort!" ); +is($results, "

Zort!

\n\n", "head4 level output"); + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +Gee, Brain, what do you want to do tonight? +EOPOD + +is($results, <<'EOHTML', "simple paragraph"); +

Gee, Brain, what do you want to do tonight?

+ +EOHTML + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +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: Mmmm, no, Brain, don't think I can. +EOPOD + +is($results, <<'EOHTML', "multiple paragraphs"); +

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: Mmmm, no, Brain, don't think I can.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=over + +=item * + +P: Gee, Brain, what do you want to do tonight? + +=item * + +B: The same thing we do every night, Pinky. Try to take over the world! + +=back + +EOPOD + +is($results, <<'EOHTML', "simple bulleted list"); +
    + +
  • P: Gee, Brain, what do you want to do tonight?
    • + +
  • B: The same thing we do every night, Pinky. Try to take over the world!
    • + +
+ +EOHTML + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=over + +=item 1 + +P: Gee, Brain, what do you want to do tonight? + +=item 2 + +B: The same thing we do every night, Pinky. Try to take over the world! + +=back + +EOPOD + +is($results, <<'EOHTML', "numbered list"); +
    + +
  1. 1. P: Gee, Brain, what do you want to do tonight?
    2. + +
  2. 2. B: The same thing we do every night, Pinky. Try to take over the world!
    3. + +
+ +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 text headings"); +
    + +
  • Pinky + +

    Gee, Brain, what do you want to do tonight?

    + +
  • Brain + +

    The same thing we do every night, Pinky. Try to take over the world!

    + +
+ +EOHTML + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + + 1 + 1 = 2; + 2 + 2 = 4; + +EOPOD + +is($results, <<'EOHTML', "code block"); +
  1 + 1 = 2;
+  2 + 2 = 4;
+ +EOHTML + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a C. +EOPOD +is($results, <<"EOHTML", "code entity in a paragraph"); +

A plain paragraph with a functionname.

+ +EOHTML + + +initialize($parser, $results); +$parser->html_header("\n"); +$parser->html_footer("\n"); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with body tags turned on. +EOPOD +is($results, <<"EOHTML", "adding html body tags"); + + + +

A plain paragraph with body tags turned on.

+ + + + +EOHTML + + +initialize($parser, $results); +$parser->html_css('style.css'); +$parser->html_header(undef); +$parser->html_footer(undef); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with body tags and css tags turned on. +EOPOD +like($results, qr//, +"adding html body tags and css tags"); + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with S. +EOPOD +is($results, <<"EOHTML", "Non breaking text in a paragraph"); +

A plain paragraph with non breaking text.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a L. +EOPOD +is($results, <<"EOHTML", "Link entity in a paragraph"); +

A plain paragraph with a Newlines.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a L. +EOPOD +is($results, <<"EOHTML", "Link entity in a paragraph"); +

A plain paragraph with a "Newlines" in perlport.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a L. +EOPOD +is($results, <<"EOHTML", "A link in a paragraph"); +

A plain paragraph with a Boo.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a L. +EOPOD +is($results, <<"EOHTML", "A link in a paragraph"); +

A plain paragraph with a http://link.included.here.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with B. +EOPOD +is($results, <<"EOHTML", "Bold text in a paragraph"); +

A plain paragraph with bold text.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with I. +EOPOD +is($results, <<"EOHTML", "Italic text in a paragraph"); +

A plain paragraph with italic text.

+ +EOHTML + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + +A plain paragraph with a F. +EOPOD +is($results, <<"EOHTML", "File name in a paragraph"); +

A plain paragraph with a filename.

+ +EOHTML + + +initialize($parser, $results); +$parser->parse_string_document(<<'EOPOD'); +=pod + + # this header is very important & don't you forget it + my $text = "File is: " . ; +EOPOD +is($results, <<"EOHTML", "Verbatim text with encodable entities"); +
  # this header is very important & don't you forget it
+  my \$text = "File is: " . <FILE>;
+ +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); + } + local $Pod::Simple::XHTML::HAS_HTML_ENTITIES = $use_html_entities; + initialize($parser, $results); + $parser->parse_string_document(<<'EOPOD'); +=pod + + # this header is very important & don't you forget it + B || 'Blank!';> + my $text = "File is: " . ; +EOPOD +is($results, <<"EOHTML", "Verbatim text with markup and embedded formatting"); +
  # this header is very important & don't you forget it
+  my \$file = <FILE> || 'Blank!';
+  my \$text = "File is: " . <FILE>;
+ +EOHTML +} + +###################################### + +sub initialize { + $_[0] = Pod::Simple::XHTML->new (); + $_[0]->html_header(""); + $_[0]->html_footer(""); + $_[0]->output_string( \$results ); # Send the resulting output to a string + $_[1] = ''; + return; +} diff -urN perl-5.10.0/lib/Pod/Simple/t.old/xhtml05.t perl-5.10.0/lib/Pod/Simple/t/xhtml05.t --- perl-5.10.0/lib/Pod/Simple/t.old/xhtml05.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/xhtml05.t 2007-09-02 08:21:41.000000000 +0200 @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +# t/xhtml05.t - check block output from Pod::Simple::XHTML + +BEGIN { + chdir 't' if -d 't'; +} + +use strict; +use lib '../lib'; +use Test::More tests => 6; + +use_ok('Pod::Simple::XHTML') or exit; + +my $parser = Pod::Simple::XHTML->new (); +isa_ok ($parser, 'Pod::Simple::XHTML'); + +my $results; +initialize($parser, $results); +$parser->accept_targets_as_text( 'comment' ); +$parser->parse_string_document(<<'EOPOD'); +=for comment +This is an ordinary for block. + +EOPOD + +is($results, <<'EOHTML', "a for block"); +
+ +

This is an ordinary for block.

+ +
+ +EOHTML + +foreach my $target qw(note tip warning) { + initialize($parser, $results); + $parser->accept_targets_as_text( $target ); + $parser->parse_string_document(<<"EOPOD"); +=begin $target + +This is a $target. + +=end $target +EOPOD + + is($results, <<"EOHTML", "allow $target blocks"); +
+ +

This is a $target.

+ +
+ +EOHTML + +} + +###################################### + +sub initialize { + $_[0] = Pod::Simple::XHTML->new (); + $_[0]->html_header(""); + $_[0]->html_footer(""); + $_[0]->output_string( \$results ); # Send the resulting output to a string + $_[1] = ''; + return; +} diff -up perl-5.10.0/lib/Pod/Simple/t/begin.t.old perl-5.10.0/lib/Pod/Simple/t/begin.t --- perl-5.10.0/lib/Pod/Simple/t/begin.t.old 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/begin.t 2008-06-03 17:06:00.000000000 +0200 @@ -7,7 +7,7 @@ BEGIN { use strict; use Test; -BEGIN { plan tests => 61 }; +BEGIN { plan tests => 62 }; my $d; #use Pod::Simple::Debug (\$d, 0); @@ -114,7 +114,6 @@ ok( $x->_out( "=pod\n\nI like pie.\n\n=b 'I like pie.Yup.' ); - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing matching because of negated non-acceptance...\n"; @@ -448,8 +447,14 @@ ok( $x->_out( \&mojprok, join "\n\n" => qq{Yup.} ); +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +print "# Testing matching of begin block titles\n"; +ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo Title\n\nstuff\n\n=end mojojojo \n\nYup.\n"), + 'I like pie.stuffYup.' +); +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Wrapping up... one for the road...\n"; ok 1; diff -up perl-5.10.0/lib/Pod/Simple/t/reinit.t.ooo perl-5.10.0/lib/Pod/Simple/t/reinit.t --- perl-5.10.0/lib/Pod/Simple/t/reinit.t.ooo 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/t/reinit.t 2008-10-06 17:31:38.000000000 +0200 @@ -13,14 +13,14 @@ BEGIN { plan tests => 5 }; sub source_path { my $file = shift; - if ($ENV{PERL_CORE}) { +# if ($ENV{PERL_CORE}) { require File::Spec; my $updir = File::Spec->updir; my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't'); return File::Spec->catfile ($dir, $file); - } else { - return $file; - } +# } else { +# return $file; +# } } use Pod::Simple::Text; diff -up perl-5.10.0/lib/Pod/t/text.t.old perl-5.10.0/lib/Pod/t/text.t --- perl-5.10.0/lib/Pod/t/text.t.old 2008-10-07 15:21:33.000000000 +0200 +++ perl-5.10.0/lib/Pod/t/text.t 2008-10-07 15:20:10.000000000 +0200 @@ -58,7 +58,7 @@ while () { } if ($output eq $expected) { print "ok $n\n"; - } elsif ($n == 4 && $Pod::Simple::VERSION < 3.06) { + } elsif ($n == 4 && $Pod::Simple::VERSION < 3.08) { print "ok $n # skip Pod::Simple S<> parsing bug\n"; } else { print "not ok $n\n"; diff -up perl-5.10.0/lib/Pod/Simple/XHTML.pm.miss perl-5.10.0/lib/Pod/Simple/XHTML.pm --- perl-5.10.0/lib/Pod/Simple/XHTML.pm.miss 2008-12-22 10:42:49.000000000 +0100 +++ perl-5.10.0/lib/Pod/Simple/XHTML.pm 2008-06-04 23:54:58.000000000 +0200 @@ -0,0 +1,400 @@ +=pod + +=head1 NAME + +Pod::Simple::XHTML -- format Pod as validating XHTML + +=head1 SYNOPSIS + + use Pod::Simple::XHTML; + + my $parser = Pod::Simple::XHTML->new(); + + ... + + $parser->parse_file('path/to/file.pod'); + +=head1 DESCRIPTION + +This class is a formatter that takes Pod and renders it as XHTML +validating HTML. + +This is a subclass of L and inherits all its +methods. The implementation is entirely different than +L, but it largely preserves the same interface. + +=cut + +package Pod::Simple::XHTML; +use strict; +use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES ); +$VERSION = '3.04'; +use Carp (); +use Pod::Simple::Methody (); +@ISA = ('Pod::Simple::Methody'); + +BEGIN { + $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1"; +} + +my %entities = ( + q{>} => 'gt', + q{<} => 'lt', + q{'} => '#39', + q{"} => 'quot', + q{&} => 'amp', +); + +sub encode_entities { + return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES; + my $str = $_[0]; + my $ents = join '', keys %entities; + $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge; + return $str; +} + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +=head1 METHODS + +Pod::Simple::XHTML offers a number of methods that modify the format of +the HTML output. Call these after creating the parser object, but before +the call to C: + + my $parser = Pod::PseudoPod::HTML->new(); + $parser->set_optional_param("value"); + $parser->parse_file($file); + +=head2 perldoc_url_prefix + +In turning L into http://whatever/Foo%3a%3aBar, what +to put before the "Foo%3a%3aBar". The default value is +"http://search.cpan.org/perldoc?". + +=head2 perldoc_url_postfix + +What to put after "Foo%3a%3aBar" in the URL. This option is not set by +default. + +=head2 title_prefix, title_postfix + +What to put before and after the title in the head. The values should +already be &-escaped. + +=head2 html_css + + $parser->html_css('path/to/style.css'); + +The URL or relative path of a CSS file to include. This option is not +set by default. + +=head2 html_javascript + +The URL or relative path of a JavaScript file to pull in. This option is +not set by default. + +=head2 html_doctype + +A document type tag for the file. This option is not set by default. + +=head2 html_header_tags + +Additional arbitrary HTML tags for the header of the document. The +default value is just a content type header tag: + + + +Add additional meta tags here, or blocks of inline CSS or JavaScript +(wrapped in the appropriate tags). + +=head2 default_title + +Set a default title for the page if no title can be determined from the +content. The value of this string should already be &-escaped. + +=head2 force_title + +Force a title for the page (don't try to determine it from the content). +The value of this string should already be &-escaped. + +=head2 html_header, html_footer + +Set the HTML output at the beginning and end of each file. The default +header includes a title, a doctype tag (if C is set), a +content tag (customized by C), a tag for a CSS file +(if C is set), and a tag for a Javascript file (if +C is set). The default footer simply closes the C +and C tags. + +The options listed above customize parts of the default header, but +setting C or C completely overrides the +built-in header or footer. These may be useful if you want to use +template tags instead of literal HTML headers and footers or are +integrating converted POD pages in a larger website. + +If you want no headers or footers output in the HTML, set these options +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). + + +=cut + +__PACKAGE__->_accessorize( + 'perldoc_url_prefix', + 'perldoc_url_postfix', + 'title_prefix', 'title_postfix', + 'html_css', + 'html_javascript', + 'html_doctype', + 'html_header_tags', + 'title', # Used internally for the title extracted from the content + 'default_title', + 'force_title', + 'html_header', + 'html_footer', + 'index', + 'batch_mode', # whether we're in batch mode + 'batch_mode_current_level', + # When in batch mode, how deep the current module is: 1 for "LWP", + # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc +); + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +=head1 SUBCLASSING + +If the standard options aren't enough, you may want to subclass +Pod::Simple::XHMTL. These are the most likely candidates for methods +you'll want to override when subclassing. + +=cut + +sub new { + my $self = shift; + my $new = $self->SUPER::new(@_); + $new->{'output_fh'} ||= *STDOUT{IO}; + $new->accept_targets( 'html', 'HTML' ); + $new->perldoc_url_prefix('http://search.cpan.org/perldoc?'); + $new->html_header_tags(''); + $new->nix_X_codes(1); + $new->codes_in_verbatim(1); + $new->{'scratch'} = ''; + return $new; +} + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +=head2 handle_text + +This method handles the body of text within any element: it's the body +of a paragraph, or everything between a "=begin" tag and the +corresponding "=end" tag, or the text within an L entity, etc. You would +want to override this if you are adding a custom element type that does +more than just display formatted text. Perhaps adding a way to generate +HTML tables from an extended version of POD. + +So, let's say you want add a custom element called 'foo'. In your +subclass's C method, after calling C you'd call: + + $new->accept_targets_as_text( 'foo' ); + +Then override the C method in the subclass to check for when +"$flags->{'target'}" is equal to 'foo' and set a flag that marks that +you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the +C method to check for the flag, and pass $text to your +custom subroutine to construct the HTML output for 'foo' elements, +something like: + + sub handle_text { + my ($self, $text) = @_; + if ($self->{'in_foo'}) { + $self->{'scratch'} .= build_foo_html($text); + } else { + $self->{'scratch'} .= $text; + } + } + +=cut + +sub handle_text { + # escape special characters in HTML (<, >, &, etc) + $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1] +} + +sub start_Para { $_[0]{'scratch'} = '

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

'; $_[0]{'in_verbatim'} = 1}
+
+sub start_head1 {  $_[0]{'scratch'} = '
' }
+sub start_head2 {  $_[0]{'scratch'} = '
' }
+sub start_head3 {  $_[0]{'scratch'} = '
' }
+sub start_head4 {  $_[0]{'scratch'} = '
' }
+
+sub start_item_bullet { $_[0]{'scratch'} = '
  • ' }
+sub start_item_number { $_[0]{'scratch'} = "
  • $_[1]{'number'}. "  }
+sub start_item_text   { $_[0]{'scratch'} = '
  • '   }
+
+sub start_over_bullet { $_[0]{'scratch'} = '
      '; $_[0]->emit }
+sub start_over_text   { $_[0]{'scratch'} = '
        '; $_[0]->emit }
+sub start_over_block  { $_[0]{'scratch'} = '
          '; $_[0]->emit }
+sub start_over_number { $_[0]{'scratch'} = '
            '; $_[0]->emit }
+
+sub end_over_bullet { $_[0]{'scratch'} .= '
        '; $_[0]->emit }
+sub end_over_text   { $_[0]{'scratch'} .= '
      '; $_[0]->emit }
+sub end_over_block  { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
+sub end_over_number { $_[0]{'scratch'} .= ''; $_[0]->emit }
+
+# . . . . . Now the actual formatters:
+
+sub end_Para     { $_[0]{'scratch'} .= '
    '; $_[0]->emit }
+sub end_Verbatim {
+    $_[0]{'scratch'}     .= '
    • '; + $_[0]{'in_verbatim'} = 0; + $_[0]->emit; +} + +sub end_head1 { $_[0]{'scratch'} .= ''; $_[0]->emit } +sub end_head2 { $_[0]{'scratch'} .= ''; $_[0]->emit } +sub end_head3 { $_[0]{'scratch'} .= ''; $_[0]->emit } +sub end_head4 { $_[0]{'scratch'} .= ''; $_[0]->emit } + +sub end_item_bullet { $_[0]{'scratch'} .= ''; $_[0]->emit } +sub end_item_number { $_[0]{'scratch'} .= ''; $_[0]->emit } +sub end_item_text { $_[0]->emit } + +# This handles =begin and =for blocks of all kinds. +sub start_for { + my ($self, $flags) = @_; + $self->{'scratch'} .= '{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'}); + $self->{'scratch'} .= '>'; + $self->emit; + +} +sub end_for { + my ($self) = @_; + $self->{'scratch'} .= ''; + $self->emit; +} + +sub start_Document { + my ($self) = @_; + if (defined $self->html_header) { + $self->{'scratch'} .= $self->html_header; + $self->emit unless $self->html_header eq ""; + } else { + my ($doctype, $title, $metatags); + $doctype = $self->html_doctype || ''; + $title = $self->force_title || $self->title || $self->default_title || ''; + $metatags = $self->html_header_tags || ''; + if ($self->html_css) { + $metatags .= "\n"; + } + if ($self->html_javascript) { + $metatags .= "\n"; + } + $self->{'scratch'} .= <<"HTML"; +$doctype + + +$title +$metatags + + +HTML + $self->emit; + } +} + +sub end_Document { + my ($self) = @_; + if (defined $self->html_footer) { + $self->{'scratch'} .= $self->html_footer; + $self->emit unless $self->html_footer eq ""; + } else { + $self->{'scratch'} .= "\n"; + $self->emit; + } +} + +# Handling code tags +sub start_B { $_[0]{'scratch'} .= '' } +sub end_B { $_[0]{'scratch'} .= '' } + +sub start_C { $_[0]{'scratch'} .= '' } +sub end_C { $_[0]{'scratch'} .= '' } + +sub start_E { $_[0]{'scratch'} .= '&' } +sub end_E { $_[0]{'scratch'} .= ';' } + +sub start_F { $_[0]{'scratch'} .= '' } +sub end_F { $_[0]{'scratch'} .= '' } + +sub start_I { $_[0]{'scratch'} .= '' } +sub end_I { $_[0]{'scratch'} .= '' } + +sub start_L { + my ($self, $flags) = @_; + my $url; + if ($flags->{'type'} eq 'url') { + $url = $flags->{'to'}; + } elsif ($flags->{'type'} eq 'pod') { + $url .= $self->perldoc_url_prefix || ''; + $url .= $flags->{'to'} || ''; + $url .= '/' . $flags->{'section'} if ($flags->{'section'}); + $url .= $self->perldoc_url_postfix || ''; +# require Data::Dumper; +# print STDERR Data::Dumper->Dump([$flags]); + } + + $self->{'scratch'} .= ''; +} +sub end_L { $_[0]{'scratch'} .= '' } + +sub start_S { $_[0]{'scratch'} .= '' } +sub end_S { $_[0]{'scratch'} .= '' } + +sub emit { + my($self) = @_; + my $out = $self->{'scratch'} . "\n"; + print {$self->{'output_fh'}} $out, "\n"; + $self->{'scratch'} = ''; + return; +} + +# Bypass built-in E<> handling to preserve entity encoding +sub _treat_Es {} + +1; + +__END__ + +=head1 SEE ALSO + +L, L + +=head1 COPYRIGHT + +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. + +This library is distributed in the hope that it will be useful, but +without any warranty; without even the implied warranty of +merchantability or fitness for a particular purpose. + +=head1 AUTHOR + +Allison Randal + +=cut +