From: Marek Rouchal 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;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 will perform syntax checking of Perl5 POD format documentation. -I - -It is hoped that curious/ambitious user will help flesh out and add the -additional features they wish to see in B and B -and verify that the checks are consistent with L. +Curious/ambitious users are welcome to propose additional features they wish +to see in B and B and verify that the checks are +consistent with L. 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 =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 module uses only the B +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 (the script). This allows users of B to +control completely the output behaviour. Users of B (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 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.