From: Marek Rouchal <marek.rouchal@infineon.com>
Date: Wed, 27 Aug 2003 17:25:28 +0000 (+0200)
Subject: RE: [PATCH] Pod::InputObjects performance de-pessimization
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c23d1eb0e18a49361001d26c686323d50b0c6d21;hp=4cbfc073c684f8df92bed18af079c31ca9949ba5;p=p5sagit%2Fp5-mst-13.2.git

RE: [PATCH] Pod::InputObjects performance de-pessimization
Message-ID: <9843A649BAD7FB4686F6FCBC840D600E08381508@mucse001.eu.infineon.com>

PodParser-1.25 prerelease.

p4raw-id: //depot/perl@20928
---

diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index 637c415..824178f 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 45bea56..e18d976 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 eae8678..9cd347b 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 85551fa..456b515 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) {
diff --git a/pod/pod2usage.PL b/pod/pod2usage.PL
index 4828d64..1c1296a 100644
--- a/pod/pod2usage.PL
+++ b/pod/pod2usage.PL
@@ -15,8 +15,9 @@ use Cwd;
 # This is so that make depend always knows where to find PL derivatives.
 $origdir = cwd;
 chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//i;
-$file .= '.COM' if ($^O eq 'VMS');
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS');              # "case-forgiving"
 
 open OUT,">$file" or die "Can't create $file: $!";
 
diff --git a/pod/podchecker.PL b/pod/podchecker.PL
index 20d5e94..1a903b5 100644
--- a/pod/podchecker.PL
+++ b/pod/podchecker.PL
@@ -148,23 +148,29 @@ pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
 ## Invoke podchecker()
 my $status = 0;
 @ARGV = qw(-) unless(@ARGV);
-for (@ARGV) {
-    if($_ eq '-') {
-      $_ = "<&STDIN";
+for my $podfile (@ARGV) {
+    if($podfile eq '-') {
+      $podfile = "<&STDIN";
     }
-    elsif(-d) {
-      warn "podchecker: Warning: Ignoring directory '$_'\n";
+    elsif(-d $podfile) {
+      warn "podchecker: Warning: Ignoring directory '$podfile'\n";
       next;
     }
-    my $s = podchecker($_, undef, '-warnings' => $options{warnings});
-    if($s > 0) {
+    my $errors = podchecker($podfile, undef, '-warnings' => $options{warnings});
+    if($errors > 0) {
         # errors occurred
+        printf STDERR ("%s has %d pod syntax %s.\n",
+          $podfile, $errors, ($errors == 1) ? "error" : "errors");
         $status = 1;
     }
-    elsif($s < 0) {
+    elsif($errors < 0) {
+        print STDERR "$podfile does not contain any pod commands.\n";
         # no pod found
         $status = 2 unless($status);
     }
+    else {
+        print STDERR "$podfile pod syntax OK.\n";
+    }
 }
 exit $status;
 
diff --git a/pod/podselect.PL b/pod/podselect.PL
index 3402b04..b6b8c9b 100644
--- a/pod/podselect.PL
+++ b/pod/podselect.PL
@@ -15,8 +15,9 @@ use Cwd;
 # This is so that make depend always knows where to find PL derivatives.
 $origdir = cwd;
 chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//i;
-$file .= '.COM' if ($^O eq 'VMS');
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS');              # "case-forgiving"
 
 open OUT,">$file" or die "Can't create $file: $!";
 
diff --git a/t/pod/find.t b/t/pod/find.t
index 4018461..412771d 100644
--- a/t/pod/find.t
+++ b/t/pod/find.t
@@ -2,41 +2,62 @@
 # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
 
 BEGIN {
+  if($ENV{PERL_CORE}) {
     chdir 't' if -d 't';
     # The ../../../../../lib is for finding lib/utf8.pm
     # when running under all-utf8 settings (pod/find.t)
     # does not directly require lib/utf8.pm but regular
     # expressions will need that.
     @INC = qw(../lib ../../../../../lib);
+  }
 }
 
 $| = 1;
 
 use Test;
 
-BEGIN { 
-  plan tests => 4; 
+BEGIN {
+  plan tests => 4;
   use File::Spec;
 }
 
 use Pod::Find qw(pod_find pod_where);
+use File::Spec;
 
 # load successful
 ok(1);
 
 require Cwd;
-my $VERBOSE = 0;
-my $lib_dir = File::Spec->catdir('pod', 'testpods', 'lib');
+my $THISDIR = Cwd::cwd();
+my $VERBOSE = $ENV{PERL_CORE} ? 0 : ($ENV{TEST_VERBOSE} || 0);
+my $lib_dir = $ENV{PERL_CORE} ? 
+  File::Spec->catdir('pod', 'testpods', 'lib')
+  : File::Spec->catdir($THISDIR,'lib');
 if ($^O eq 'VMS') {
-    $lib_dir = VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'));
+    $lib_dir = $ENV{PERL_CORE} ?
+      VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'))
+      : VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
     $Qlib_dir = $lib_dir;
     $Qlib_dir =~ s#\/#::#g;
 }
+
 print "### searching $lib_dir\n";
 my %pods = pod_find($lib_dir);
 my $result = join(',', sort values %pods);
-my $compare = join(',', sort qw(
+print "### found $result\n";
+my $compare = $ENV{PERL_CORE} ? 
+  join(',', sort qw(
     Pod::Stuff
+))
+  : join(',', qw(
+    Pod::Checker
+    Pod::Find
+    Pod::InputObjects
+    Pod::ParseUtils
+    Pod::Parser
+    Pod::PlainText
+    Pod::Select
+    Pod::Usage
 ));
 if ($^O eq 'VMS') {
     $compare = lc($compare);
@@ -53,14 +74,13 @@ if ($^O eq 'VMS') {
     }
     ok($count/($#result+1)-1,$#compare);
 }
-elsif ($^O eq 'dos') {
+elsif (File::Spec->case_tolerant || $^O eq 'dos') {
     ok(lc $result,lc $compare);
 }
 else {
     ok($result,$compare);
 }
 
-
 print "### searching for File::Find\n";
 $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
   || 'undef - pod not found!';
@@ -74,19 +94,38 @@ if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
     ok($result,$compare);
 }
 else {
-    $compare = File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm');
+    $compare = $ENV{PERL_CORE} ?
+      File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm')
+      : File::Spec->catfile($Config::Config{privlib},"File","Find.pm");
     ok(_canon($result),_canon($compare));
 }
 
 # Search for a documentation pod rather than a module
-print "### searching for Stuff.pod\n";
-my $search = File::Spec->catdir('pod', 'testpods', 'lib', 'Pod');
-$result = pod_where({ -dirs => [$search], -verbose => $VERBOSE }, 'Stuff')
-  || 'undef - Stuff.pod not found!';
+my $searchpod = $ENV{PERL_CORE} ? 'Stuff' : 'perlfunc';
+print "### searching for $searchpod.pod\n";
+$result = pod_where($ENV{PERL_CORE} ?
+  { -dirs => [ File::Spec->catdir('pod', 'testpods', 'lib', 'Pod') ],
+    -verbose => $VERBOSE }
+  : { -inc => 1, -verbose => $VERBOSE }, $searchpod)
+  || "undef - $searchpod.pod not found!";
 print "### found $result\n";
 
-$compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pod');
-ok(_canon($result),_canon($compare));
+if($ENV{PERL_CORE}) {
+    $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
+    ok(_canon($result),_canon($compare));
+}
+elsif ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
+    $compare = "/lib/pod/perlfunc.pod";
+    $result = VMS::Filespec::unixify($result);
+    $result =~ s/perl_root\///i;
+    $result =~ s/^\.\.//;  # needed under `mms test`
+    ok($result,$compare);
+}
+else {
+    $compare = File::Spec->catfile($Config::Config{privlib},
+      ($^O =~ /macos|darwin|cygwin/i ? 'pods' : 'pod'),"perlfunc.pod");
+    ok(_canon($result),_canon($compare));
+}
 
 # make the path as generic as possible
 sub _canon
@@ -96,8 +135,9 @@ sub _canon
   my @comp = File::Spec->splitpath($path);
   my @dir = File::Spec->splitdir($comp[1]);
   $comp[1] = File::Spec->catdir(@dir);
-  $path = File::Spec->catpath(@dir);
+  $path = File::Spec->catpath(@comp);
   $path = uc($path) if File::Spec->case_tolerant;
+  print "### general path: $path\n" if $VERBOSE;
   $path;
 }
 
diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr
index de337b9..3d0dd8c 100644
--- a/t/pod/poderrs.xr
+++ b/t/pod/poderrs.xr
@@ -46,4 +46,3 @@
 *** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t
 *** ERROR: unresolved internal link 'I/O Operators' at line 202 in file t/pod/poderrs.t
 *** WARNING: multiple occurrence of link target 'Misc' at line - in file t/pod/poderrs.t
-t/pod/poderrs.t has 34 pod syntax errors.