Upgrade to Pod-Simple-3.06
Steve Peters [Wed, 4 Jun 2008 19:20:20 +0000 (19:20 +0000)]
p4raw-id: //depot/perl@33997

12 files changed:
MANIFEST
lib/Pod/Simple.pm
lib/Pod/Simple.pod
lib/Pod/Simple/BlackBox.pm
lib/Pod/Simple/HTML.pm
lib/Pod/Simple/HTMLBatch.pm
lib/Pod/Simple/XHTML.pm [new file with mode: 0644]
lib/Pod/Simple/t/begin.t
lib/Pod/Simple/t/fcodes_l.t
lib/Pod/Simple/t/fcodes_s.t
lib/Pod/Simple/t/xhtml01.t [new file with mode: 0644]
lib/Pod/Simple/t/xhtml05.t [new file with mode: 0644]

index ef8dd37..b4bba83 100644 (file)
--- 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
index 6beacaa..0b26a2f 100644 (file)
@@ -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 = '';
index b0a8a6f..a582173 100644 (file)
@@ -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
 
index 6d7fdba..4804973 100644 (file)
@@ -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,})
             )
           )+
         )
index c0a505d..a4dbbc1 100644 (file)
@@ -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!
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index bce0a44..cb26cab 100644 (file)
@@ -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 (file)
index 0000000..05c25da
--- /dev/null
@@ -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
+
index 204a903..3b40095 100644 (file)
@@ -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;
index b3b1b2b..7865a08 100644 (file)
@@ -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.
index 502753e..1486687 100644 (file)
@@ -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 (file)
index 0000000..37e295c
--- /dev/null
@@ -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 &amp; don&#39;t you forget it
+  my \$text = &quot;File is: &quot; . &lt;FILE&gt;;</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 &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 --git a/lib/Pod/Simple/t/xhtml05.t b/lib/Pod/Simple/t/xhtml05.t
new file mode 100644 (file)
index 0000000..4e2738e
--- /dev/null
@@ -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;
+}