diff options
author | Steve Peters <steve@fisharerojo.org> | 2008-06-04 19:20:20 +0000 |
---|---|---|
committer | Steve Peters <steve@fisharerojo.org> | 2008-06-04 19:20:20 +0000 |
commit | 69473a205b8f154ba006fb7b0bb2ce73626e18c3 (patch) | |
tree | 8e51f8ca3ea8ebd02b0ddda0d9021d2fd12c75a9 /lib/Pod | |
parent | f0291b57b36831927aaa01a24eedab2c7804fdf2 (diff) | |
download | perl-69473a205b8f154ba006fb7b0bb2ce73626e18c3.tar.gz |
Upgrade to Pod-Simple-3.06
p4raw-id: //depot/perl@33997
Diffstat (limited to 'lib/Pod')
-rw-r--r-- | lib/Pod/Simple.pm | 108 | ||||
-rw-r--r-- | lib/Pod/Simple.pod | 10 | ||||
-rw-r--r-- | lib/Pod/Simple/BlackBox.pm | 20 | ||||
-rw-r--r-- | lib/Pod/Simple/HTML.pm | 2 | ||||
-rw-r--r-- | lib/Pod/Simple/HTMLBatch.pm | 4 | ||||
-rw-r--r-- | lib/Pod/Simple/XHTML.pm | 382 | ||||
-rw-r--r-- | lib/Pod/Simple/t/begin.t | 9 | ||||
-rw-r--r-- | lib/Pod/Simple/t/fcodes_l.t | 23 | ||||
-rw-r--r-- | lib/Pod/Simple/t/fcodes_s.t | 25 | ||||
-rw-r--r-- | lib/Pod/Simple/t/xhtml01.t | 345 | ||||
-rw-r--r-- | lib/Pod/Simple/t/xhtml05.t | 67 |
11 files changed, 929 insertions, 66 deletions
diff --git a/lib/Pod/Simple.pm b/lib/Pod/Simple.pm index 6beacaa1c8..0b26a2fbaa 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<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 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: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 friends, the L<...> sequences # 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 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 b0a8a6f6d0..a58217336a 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<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 --git a/lib/Pod/Simple/BlackBox.pm b/lib/Pod/Simple/BlackBox.pm index 6d7fdba4fb..4804973a2e 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 c0a505d533..a4dbbc17d0 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 bce0a44b45..cb26cabf37 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 0000000000..05c25daf71 --- /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<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 ); +$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<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 + diff --git a/lib/Pod/Simple/t/begin.t b/lib/Pod/Simple/t/begin.t index 204a903796..3b40095d22 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\nI<Stuf '<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 --git a/lib/Pod/Simple/t/fcodes_l.t b/lib/Pod/Simple/t/fcodes_l.t index b3b1b2b27c..7865a08e9d 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" '<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 --git a/lib/Pod/Simple/t/fcodes_s.t b/lib/Pod/Simple/t/fcodes_s.t index 502753ec95..14866873d1 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 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 --git a/lib/Pod/Simple/t/xhtml01.t b/lib/Pod/Simple/t/xhtml01.t new file mode 100644 index 0000000000..37e295c411 --- /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, "<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 & don't you forget it + my \$text = "File is: " . <FILE>;</code></pre> + +EOHTML + +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 & don't you forget it + <b>my \$file = <FILE> || 'Blank!';</b> + my \$text = "File is: " . <FILE>;</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 --git a/lib/Pod/Simple/t/xhtml05.t b/lib/Pod/Simple/t/xhtml05.t new file mode 100644 index 0000000000..4e2738ee7f --- /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"); +<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; +} |