RE: [PATCH] Pod::InputObjects performance de-pessimization

Message-ID: <9843A649BAD7FB4686F6FCBC840D600E08381508@mucse001.eu.infineon.com>

PodParser-1.25 prerelease.

p4raw-id: //depot/perl@20928

4 files changed, 47 insertions, 41 deletions

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index 637c415d9d..824178f61c 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
 package Pod::Checker;
 
 use vars qw($VERSION);
-$VERSION = 1.40;  ## Current version of this package
+$VERSION = 1.41;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 use Pod::ParseUtils; ## for hyperlinks and lists
@@ -53,11 +53,9 @@ trigger additional warnings. See L<"Warnings">.
 
 B<podchecker> will perform syntax checking of Perl5 POD format documentation.
 
-I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!>
-
-It is hoped that curious/ambitious user will help flesh out and add the
-additional features they wish to see in B<Pod::Checker> and B<podchecker>
-and verify that the checks are consistent with L<perlpod>.
+Curious/ambitious users are welcome to propose additional features they wish
+to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
+consistent with L<perlpod>.
 
 The following checks are currently preformed:
 
@@ -319,7 +317,7 @@ there were no POD commands at all found in the file.
 
 =head1 EXAMPLES
 
-I<[T.B.D.]>
+See L</SYNOPSIS>
 
 =head1 INTERFACE
 
@@ -329,6 +327,13 @@ POD translators can use this feature to syntax-check and get the nodes in
 a first pass before actually starting to convert. This is expensive in terms
 of execution time, but allows for very robust conversions.
 
+Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
+method to print errors and warnings. The summary output (e.g. 
+"Pod syntax OK") has been dropped from the module and has been included in
+B<podchecker> (the script). This allows users of B<Pod::Checker> to
+control completely the output behaviour. Users of B<podchecker> (the script)
+get the well-known behaviour.
+
 =cut
 
 #############################################################################
@@ -742,7 +747,6 @@ sub end_pod {
     my $out_fh = $self->output_handle();
 
     if(@{$self->{_list_stack}}) {
-        # _TODO_ display, but don't count them for now
         my $list;
         while(($list = $self->_close_list('EOF',$infile)) &&
           $list->indent() ne 'auto') {
@@ -790,19 +794,8 @@ sub end_pod {
             -msg => "multiple occurrence of link target '$_'"});
     }
 
-    ## Print the number of errors found
-    my $num_errors = $self->num_errors();
-    if ($num_errors > 0) {
-        printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
-                      ($num_errors == 1) ? "error" : "errors");
-    }
-    elsif($self->{_commands} == 0) {
-        print $out_fh "$infile does not contain any pod commands.\n";
-        $self->num_errors(-1);
-    }
-    else {
-        print $out_fh "$infile pod syntax OK.\n";
-    }
+    # no POD found here
+    $self->num_errors(-1) if($self->{_commands} == 0);
 }
 
 # check a POD command directive
@@ -1078,17 +1071,17 @@ sub _check_ptree {
     foreach(@$ptree) {
         # regular text chunk
         unless(ref) {
-            my $count;
             # count the unescaped angle brackets
             # complain only when warning level is greater than 1
-            my $i = $_;
-            if($count = $i =~ tr/<>/<>/) {
+            if($self->{-warnings} && $self->{-warnings}>1) {
+              my $count;
+              if($count = tr/<>/<>/) {
                 $self->poderror({ -line => $line, -file => $file,
                      -severity => 'WARNING', 
-                     -msg => "$count unescaped <> in paragraph" })
-                if($self->{-warnings} && $self->{-warnings}>1);
+                     -msg => "$count unescaped <> in paragraph" });
+                }
             }
-            $text .= $i;
+            $text .= $_;
             next;
         }
         # have an interior sequence
diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm
index 45bea56a43..e18d976ffb 100644
--- a/lib/Pod/Find.pm
+++ b/lib/Pod/Find.pm
@@ -13,7 +13,7 @@
 package Pod::Find;
 
 use vars qw($VERSION);
-$VERSION = 0.23;   ## Current version of this package
+$VERSION = 0.24;   ## Current version of this package
 require  5.005;   ## requires this Perl version or later
 use Carp;
 
@@ -446,13 +446,14 @@ sub pod_where {
         if $options{'-verbose'};
       next Dir;
     }
-    # for some strange reason the path on MacOS/darwin is
+    # for some strange reason the path on MacOS/darwin/cygwin is
     # 'pods' not 'pod'
     # this could be the case also for other systems that
     # have a case-tolerant file system, but File::Spec
-    # does not recognize 'darwin' yet
-    #if(File::Spec->case_tolerant && -d File::Spec->catdir($dir,'pods')) {
-    if($^O =~ /macos|darwin/i && -d File::Spec->catdir($dir,'pods')) {
+    # does not recognize 'darwin' yet. And cygwin also has "pods",
+    # but is not case tolerant. Oh well...
+    if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
+     && -d File::Spec->catdir($dir,'pods')) {
       $dir = File::Spec->catdir($dir,'pods');
       redo Dir;
     }
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
index eae8678e46..9cd347b969 100644
--- a/lib/Pod/InputObjects.pm
+++ b/lib/Pod/InputObjects.pm
@@ -11,7 +11,7 @@
 package Pod::InputObjects;
 
 use vars qw($VERSION);
-$VERSION = 1.13;  ## Current version of this package
+$VERSION = 1.14;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -855,9 +855,15 @@ the current one.
 sub append {
    my $self = shift;
    local *ptree = $self;
+   my $can_append = @ptree && !(ref $ptree[-1]);
    for (@_) {
-      next  unless length;
-      if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
+      if (ref) {
+         push @ptree, $_;
+      }
+      elsif(!length) {
+         next;
+      }
+      elsif ($can_append) {
          $ptree[-1] .= $_;
       }
       else {
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index 85551faca8..456b515b9a 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -788,13 +788,15 @@ sub parse_text {
         ## Look for the beginning of a sequence
         if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
             ## Push a new sequence onto the stack of those "in-progress"
-            ($cmd, $ldelim) = ($1, $2);
+            my $ldelim_orig;
+            ($cmd, $ldelim_orig) = ($1, $2);
+            ($ldelim = $ldelim_orig) =~ s/\s+$//;
+            ($rdelim = $ldelim) =~ tr/</>/;
             $seq = Pod::InteriorSequence->new(
                        -name   => $cmd,
-                       -ldelim => $ldelim,  -rdelim => '',
+                       -ldelim => $ldelim_orig,  -rdelim => $rdelim,
                        -file   => $file,    -line   => $line
                    );
-            $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
             (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
             push @seq_stack, $seq;
         }
@@ -827,9 +829,13 @@ sub parse_text {
                 $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
                                                    : $seq);
                 ## Remember the current cmd-name and left-delimiter
-                $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
-                $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
-                $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
+                if(@seq_stack > 1) {
+                    $cmd = $seq_stack[-1]->name;
+                    $ldelim = $seq_stack[-1]->ldelim;
+                    $rdelim = $seq_stack[-1]->rdelim;
+                } else {
+                    $cmd = $ldelim = $rdelim = '';
+                }
             }
         }
         elsif (length) {