rpms/perl
3
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
1c87f00c6f
perl/perl-5.10.0-PodSimple.patch
Marcela Mašláňová e3bdec83b4 - add missing XHTML.pm into Pod::Simple
2008-12-22 10:06:37 +00:00

1607 lines
51 KiB
Diff
Raw Blame History

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<text|name/"sec"> or L<text|name/sec>
# L<text|/"sec"> or L<text|/sec> or L<text|"sec">
# L<scheme:...>
+ # 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:xE<at>foo.com
+ # -> [ 'mailto:x', [ E ... ], 'foo.com' ]
+ # 4) text node containing url start and text: foo|mailto:xE<at>foo.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<URL> 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 "L<foo:bazE<123>bar>"). 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<URL> 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<URL> 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<Foo::Bar> or even L<Thing::1.0::Docs::Tralala>
DEBUG > 1 and print "Catching \"$it\" as ho-hum L<Modulename> 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<sburke@cpan.org>
-Maintained by: Allison Randal C<allison@perl.org>
+Maintained by:
+
+=over
+
+=item * Allison Randal C<allison@perl.org>
+
+=item * Hans Dieter Pearcey C<hdp@cpan.org>
+
+=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 @@
'<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> 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>'
+);
+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>'
+);
+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>'
+);
+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>'
+);
+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>'
+);
+
+
+
#
# 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 L<StuffE<160>I<likeE<160>that>|"bric-a-brac a gogo">.\n},
));
+use Pod::Simple::Text;
+$x = Pod::Simple::Text->new;
+$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
+Both pod2text and pod2man S< > lose the rest of the line
+
+=head1 Do they always S< > lose the rest of the line?
+
+=cut
+END
+ ),
+ <<END
+The Tk::mega manpage showed me how S< > 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"),
- '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'
-);
-
-ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),
- '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'
-);
-
-
-print "# Wrapping up... one for the road...\n";
-ok 1;
-print "# --- Done with ", __FILE__, " --- \n";
-
+# Testing the =item directive
+BEGIN {
+ if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 4 };
+
+my $d;
+#use Pod::Simple::Debug (\$d,0);
+
+ok 1;
+
+use Pod::Simple::DumpAsXML;
+use Pod::Simple::XMLOutStream;
+print "# Pod::Simple version $Pod::Simple::VERSION\n";
+sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }
+
+my $x = 'Pod::Simple::XMLOutStream';
+
+print "##### Tests for =item directives via class $x\n";
+
+$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';
+$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output
+
+
+print "#\n# Tests for =item [number] that are icky...\n";
+ok( $x->_out("\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+
+print "# Wrapping up... one for the road...\n";
+ok 1;
+print "# --- Done with ", __FILE__, " --- \n";
+
diff -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/<name>.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, "<h1>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");
+
+initialize($parser, $results);
+$parser->parse_string_document( "=head3 I say, Brain..." );
+is($results, "<h3>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");
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+Gee, Brain, what do you want to do tonight?
+EOPOD
+
+is($results, <<'EOHTML', "simple paragraph");
+<p>Gee, Brain, what do you want to do tonight?</p>
+
+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");
+<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>
+
+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");
+<ul>
+
+<li>P: Gee, Brain, what do you want to do tonight?</li>
+
+<li>B: The same thing we do every night, Pinky. Try to take over the world!</li>
+
+</ul>
+
+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");
+<ol>
+
+<li>1. P: Gee, Brain, what do you want to do tonight?</li>
+
+<li>2. B: The same thing we do every night, Pinky. Try to take over the world!</li>
+
+</ol>
+
+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");
+<ul>
+
+<li>Pinky
+
+<p>Gee, Brain, what do you want to do tonight?</p>
+
+<li>Brain
+
+<p>The same thing we do every night, Pinky. Try to take over the world!</p>
+
+</ul>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+ 1 + 1 = 2;
+ 2 + 2 = 4;
+
+EOPOD
+
+is($results, <<'EOHTML', "code block");
+<pre><code> 1 + 1 = 2;
+ 2 + 2 = 4;</code></pre>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a C<functionname>.
+EOPOD
+is($results, <<"EOHTML", "code entity in a paragraph");
+<p>A plain paragraph with a <code>functionname</code>.</p>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->html_header("<html>\n<body>");
+$parser->html_footer("</body>\n</html>");
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with body tags turned on.
+EOPOD
+is($results, <<"EOHTML", "adding html body tags");
+<html>
+<body>
+
+<p>A plain paragraph with body tags turned on.</p>
+
+</body>
+</html>
+
+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/<link rel='stylesheet' href='style.css' type='text\/css'>/,
+"adding html body tags and css tags");
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with S<non breaking text>.
+EOPOD
+is($results, <<"EOHTML", "Non breaking text in a paragraph");
+<p>A plain paragraph with <nobr>non breaking text</nobr>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<Newlines>.
+EOPOD
+is($results, <<"EOHTML", "Link entity in a paragraph");
+<p>A plain paragraph with a <a href="${PERLDOC}Newlines">Newlines</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+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>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<Boo|http://link.included.here>.
+EOPOD
+is($results, <<"EOHTML", "A link in a paragraph");
+<p>A plain paragraph with a <a href="http://link.included.here">Boo</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<http://link.included.here>.
+EOPOD
+is($results, <<"EOHTML", "A link in a paragraph");
+<p>A plain paragraph with a <a href="http://link.included.here">http://link.included.here</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with B<bold text>.
+EOPOD
+is($results, <<"EOHTML", "Bold text in a paragraph");
+<p>A plain paragraph with <b>bold text</b>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with I<italic text>.
+EOPOD
+is($results, <<"EOHTML", "Italic text in a paragraph");
+<p>A plain paragraph with <i>italic text</i>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a F<filename>.
+EOPOD
+is($results, <<"EOHTML", "File name in a paragraph");
+<p>A plain paragraph with a <i>filename</i>.</p>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+ # this header is very important & don't you forget it
+ my $text = "File is: " . <FILE>;
+EOPOD
+is($results, <<"EOHTML", "Verbatim text with encodable entities");
+<pre><code> # this header is very important &amp; don&#39;t you forget it
+ my \$text = &quot;File is: &quot; . &lt;FILE&gt;;</code></pre>
+
+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<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 &amp; don&#39;t you forget it
+ <b>my \$file = &lt;FILE&gt; || &#39;Blank!&#39;;</b>
+ my \$text = &quot;File is: &quot; . &lt;FILE&gt;;</code></pre>
+
+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");
+<div class="comment">
+
+<p>This is an ordinary for block.</p>
+
+</div>
+
+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");
+<div class="$target">
+
+<p>This is a $target.</p>
+
+</div>
+
+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
'<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>'
);
-
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print "# Testing matching because of negated non-acceptance...\n";
@@ -448,8 +447,14 @@ ok( $x->_out( \&mojprok, join "\n\n" =>
qq{<Para>Yup.</Para></Document>}
);
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+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"),
+ '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo" title="Title"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>'
+);
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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 (<DATA>) {
}
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<Pod::Simple::Methody> and inherits all its
+methods. The implementation is entirely different than
+L<Pod::Simple::HTML>, 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<parse_file>:
+
+ my $parser = Pod::PseudoPod::HTML->new();
+ $parser->set_optional_param("value");
+ $parser->parse_file($file);
+
+=head2 perldoc_url_prefix
+
+In turning L<Foo::Bar> 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:
+
+ <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
+
+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<html_doctype> is set), a
+content tag (customized by C<html_header_tags>), a tag for a CSS file
+(if C<html_css> is set), and a tag for a Javascript file (if
+C<html_javascript> is set). The default footer simply closes the C<html>
+and C<body> tags.
+
+The options listed above customize parts of the default header, but
+setting C<html_header> or C<html_footer> 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('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">');
+ $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<new> method, after calling C<SUPER::new> you'd call:
+
+ $new->accept_targets_as_text( 'foo' );
+
+Then override the C<start_for> 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<handle_text> 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'} = '<p>' }
+sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1}
+
+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_bullet { $_[0]{'scratch'} = '<li>' }
+sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. " }
+sub start_item_text { $_[0]{'scratch'} = '<li>' }
+
+sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_text { $_[0]{'scratch'} = '<ul>'; $_[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 }
+
+# . . . . . 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_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
+sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[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'} .= '<div';
+ $self->{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'});
+ $self->{'scratch'} .= '>';
+ $self->emit;
+
+}
+sub end_for {
+ my ($self) = @_;
+ $self->{'scratch'} .= '</div>';
+ $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<link rel='stylesheet' href='" .
+ $self->html_css . "' type='text/css'>";
+ }
+ if ($self->html_javascript) {
+ $metatags .= "\n<script type='text/javascript' src='" .
+ $self->html_javascript . "'></script>";
+ }
+ $self->{'scratch'} .= <<"HTML";
+$doctype
+<html>
+<head>
+<title>$title</title>
+$metatags
+</head>
+<body>
+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'} .= "</body>\n</html>";
+ $self->emit;
+ }
+}
+
+# Handling code tags
+sub start_B { $_[0]{'scratch'} .= '<b>' }
+sub end_B { $_[0]{'scratch'} .= '</b>' }
+
+sub start_C { $_[0]{'scratch'} .= '<code>' }
+sub end_C { $_[0]{'scratch'} .= '</code>' }
+
+sub start_E { $_[0]{'scratch'} .= '&' }
+sub end_E { $_[0]{'scratch'} .= ';' }
+
+sub start_F { $_[0]{'scratch'} .= '<i>' }
+sub end_F { $_[0]{'scratch'} .= '</i>' }
+
+sub start_I { $_[0]{'scratch'} .= '<i>' }
+sub end_I { $_[0]{'scratch'} .= '</i>' }
+
+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'} .= '<a href="'. $url . '">';
+}
+sub end_L { $_[0]{'scratch'} .= '</a>' }
+
+sub start_S { $_[0]{'scratch'} .= '<nobr>' }
+sub end_S { $_[0]{'scratch'} .= '</nobr>' }
+
+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<Pod::Simple>, L<Pod::Simple::Methody>
+
+=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 <allison@perl.org>
+
+=cut
+
Reference in New Issue View Git Blame Copy Permalink