From: Steve Peters Date: Wed, 4 Jun 2008 19:20:20 +0000 (+0000) Subject: Upgrade to Pod-Simple-3.06 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=69473a205b8f154ba006fb7b0bb2ce73626e18c3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Pod-Simple-3.06 p4raw-id: //depot/perl@33997 --- diff --git a/MANIFEST b/MANIFEST index ef8dd37..b4bba83 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2566,6 +2566,9 @@ lib/Pod/Simple/t/tiedfh.t Pod::Simple test file lib/Pod/Simple/t/verbatim.t Pod::Simple test file lib/Pod/Simple/t/verb_fmt.t Pod::Simple test file lib/Pod/Simple/t/x_nixer.t Pod::Simple test file +lib/Pod/Simple/t/xhtml01.t Pod::Simple test file +lib/Pod/Simple/t/xhtml05.t Pod::Simple test file +lib/Pod/Simple/XHTML.pm turn Pod into XHTML lib/Pod/Simple/XMLOutStream.pm turn Pod into XML lib/Pod/t/basic.cap podlators test lib/Pod/t/basic.clr podlators test diff --git a/lib/Pod/Simple.pm b/lib/Pod/Simple.pm index 6beacaa..0b26a2f 100644 --- a/lib/Pod/Simple.pm +++ b/lib/Pod/Simple.pm @@ -18,7 +18,7 @@ use vars qw( ); @ISA = ('Pod::Simple::BlackBox'); -$VERSION = '3.05'; +$VERSION = '3.06'; @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 friends, the L<...> sequences # 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 friends, the L<...> sequences # 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 friends, the L<...> sequences } # 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 friends, the L<...> sequences # 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 friends, the L<...> sequences 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 --git a/lib/Pod/Simple.pod b/lib/Pod/Simple.pod index b0a8a6f..a582173 100644 --- a/lib/Pod/Simple.pod +++ b/lib/Pod/Simple.pod @@ -211,7 +211,15 @@ merchantability or fitness for a particular purpose. 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 --git a/lib/Pod/Simple/BlackBox.pm b/lib/Pod/Simple/BlackBox.pm index 6d7fdba..4804973 100644 --- a/lib/Pod/Simple/BlackBox.pm +++ b/lib/Pod/Simple/BlackBox.pm @@ -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 --git a/lib/Pod/Simple/HTML.pm b/lib/Pod/Simple/HTML.pm index c0a505d..a4dbbc1 100644 --- a/lib/Pod/Simple/HTML.pm +++ b/lib/Pod/Simple/HTML.pm @@ -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 --git a/lib/Pod/Simple/HTMLBatch.pm b/lib/Pod/Simple/HTMLBatch.pm index bce0a44..cb26cab 100644 --- a/lib/Pod/Simple/HTMLBatch.pm +++ b/lib/Pod/Simple/HTMLBatch.pm @@ -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 --git a/lib/Pod/Simple/XHTML.pm b/lib/Pod/Simple/XHTML.pm new file mode 100644 index 0000000..05c25da --- /dev/null +++ b/lib/Pod/Simple/XHTML.pm @@ -0,0 +1,382 @@ +=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 ); +$VERSION = '3.04'; +use Carp (); +use Pod::Simple::Methody (); +@ISA = ('Pod::Simple::Methody'); + +use HTML::Entities 'encode_entities'; + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +=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 + diff --git a/lib/Pod/Simple/t/begin.t b/lib/Pod/Simple/t/begin.t index 204a903..3b40095 100644 --- a/lib/Pod/Simple/t/begin.t +++ b/lib/Pod/Simple/t/begin.t @@ -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=begin :psketti,mojojojo,crunk\n\n\nII 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 --git a/lib/Pod/Simple/t/fcodes_l.t b/lib/Pod/Simple/t/fcodes_l.t index b3b1b2b..7865a08 100644 --- a/lib/Pod/Simple/t/fcodes_l.t +++ b/lib/Pod/Simple/t/fcodes_l.t @@ -7,7 +7,7 @@ BEGIN { use strict; use Test; -BEGIN { plan tests => 93 }; +BEGIN { plan tests => 99 }; #use Pod::Simple::Debug (10); @@ -398,6 +398,27 @@ ok( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|"Member Data" '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 --git a/lib/Pod/Simple/t/fcodes_s.t b/lib/Pod/Simple/t/fcodes_s.t index 502753e..1486687 100644 --- a/lib/Pod/Simple/t/fcodes_s.t +++ b/lib/Pod/Simple/t/fcodes_s.t @@ -7,7 +7,7 @@ BEGIN { use strict; use Test; -BEGIN { plan tests => 13 }; +BEGIN { plan tests => 14 }; #use Pod::Simple::Debug (6); @@ -76,7 +76,30 @@ skip( $unless_ascii, 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 --git a/lib/Pod/Simple/t/xhtml01.t b/lib/Pod/Simple/t/xhtml01.t new file mode 100644 index 0000000..37e295c --- /dev/null +++ b/lib/Pod/Simple/t/xhtml01.t @@ -0,0 +1,345 @@ +#!/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 => 25; + +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. + +
    3. 2. B: The same thing we do every night, Pinky. Try to take over the world!
    4. + +
    + +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 + +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 --git a/lib/Pod/Simple/t/xhtml05.t b/lib/Pod/Simple/t/xhtml05.t new file mode 100644 index 0000000..4e2738e --- /dev/null +++ b/lib/Pod/Simple/t/xhtml05.t @@ -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; +}