develooper Front page | perl.perl5.porters | Postings from March 2000

PodParser-1.13 to be uploaded to CPAN

From:
Brad Appleton
Date:
March 15, 2000 23:12
Subject:
PodParser-1.13 to be uploaded to CPAN
Message ID:
200003160712.BAA10675@agogic.cig.mot.com
I will soon be uploading version 1.13 of PodParser to CPAN. Until it
shows up at a mirror near you, it can also be obtained from my own
personal FTP site at:

   ftp://ftp.enteract.com/users/bradapp/src/libs/Perl/PodParser-1.13.tar.gz

with any luck, this version fixes the output-comparison code so that
it ignores any and all OS path character differences in filenames for
output from podchecker.

Here are the patches (after my signature).

This patch should be used *instead* *of* an earlier patch posted On Tue,
Mar 14, 2000 at by Haakon Alstadheim to make PodParser-1.12 to pass all
tests on Windows NT. That patch attempted to modify the comparison input
source rather than the comparison method - please use this patch instead.

-- 
Brad Appleton <bradapp@enteract.com> http://www.enteract.com/~bradapp/
  "And miles to go before I sleep." -- Robert Frost



diff -rcN PodParser-1.12/CHANGES PodParser-1.13/CHANGES
*** PodParser-1.12/CHANGES	Thu Mar 16 00:50:36 2000
--- PodParser-1.13/CHANGES	Thu Mar 16 00:46:25 2000
***************
*** 1,3 ****
--- 1,16 ----
+  14-Mar-2000           Marek Rouchal      <marek@saftsack.fs.uni-bayreuth.de>
+  16-Mar-2000           Brad Appleton                   <bradapp@enteract.com>
+  -----------------------------------------------------------------------------
+  Version 1.13
+  + Improved support of Win32 and OS/2 platforms by using File::Spec in
+    Pod::Find
+  + strip .bat and .cmd on Win32 and OS/2, respectively
+  + removed all tabs from Pod::Find and reviewed POD documentation
+  + finally fixed t/pod/ptestpchk.pl to ignore any and all non-word-chars
+    in pathnames. No more special casing filenames for MacOS, NT, VMS, etc
+    just for the sake of passing the t/pod/poderrs.t test!
+ 
+ 
   11-Mar-2000           Brad Appleton                   <bradapp@enteract.com>
   -----------------------------------------------------------------------------
   Version 1.12
diff -rcN PodParser-1.12/Makefile.PL PodParser-1.13/Makefile.PL
*** PodParser-1.12/Makefile.PL	Thu Mar 16 00:55:48 2000
--- PodParser-1.13/Makefile.PL	Thu Mar 16 00:55:52 2000
***************
*** 48,54 ****
  WriteMakefile(
      NAME         => $DISTMOD,
      DISTNAME     => $DISTNAME,
!     VERSION_FROM => 'lib/Pod/Parser.pm',  ## Finds distribution $VERSION
      PL_FILES     => { map { (script("$_.PL") => script($_)) } @SCRIPTS },
      EXE_FILES    => [ @EXE_FILES ],
      dist         => { COMPRESS => 'gzip', SUFFIX => 'gz' },
--- 48,54 ----
  WriteMakefile(
      NAME         => $DISTMOD,
      DISTNAME     => $DISTNAME,
!     VERSION      => 1.13,
      PL_FILES     => { map { (script("$_.PL") => script($_)) } @SCRIPTS },
      EXE_FILES    => [ @EXE_FILES ],
      dist         => { COMPRESS => 'gzip', SUFFIX => 'gz' },
diff -rcN PodParser-1.12/t/pod/testpchk.pl PodParser-1.13/t/pod/testpchk.pl
*** PodParser-1.12/t/pod/testpchk.pl	Thu Mar 16 00:36:36 2000
--- PodParser-1.13/t/pod/testpchk.pl	Thu Mar 16 00:42:13 2000
***************
*** 34,64 ****
     ## filter out platform-dependent aspects of error messages
     my ($line1, $line2) = @_;
     for ($line1, $line2) {
!       if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
!           my $fname = $1;
!           s/^#*\s*//  if ($^O eq 'MacOS');
!           s/^\s*\Q$fname\E/stripname($fname)/e;
!       }
!       elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
!           s/^#*\s*//  if ($^O eq 'MacOS');
!           s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
!           s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
!       }
     }
!    my $x = $line1 ne $line2;
!    return $x if (!$x || $^O ne 'VMS');
! 
!    # if not identical, it could be because of differing file naming
!    my (@a) = split(/\s/,$line2);     # 'standard'
!    my (@b) = split(/\s/,$line1);     # vmsish
! 
!    foreach (@a) {
!      $x = shift(@b);
!      next if $x eq $_;
!      next if lc(VMS::Filespec::unixify($x)) eq lc($_);
!      return 1;
!    }
!    return $#b >= 0;
  }
  
  sub testpodcheck( @ ) {
--- 34,45 ----
     ## filter out platform-dependent aspects of error messages
     my ($line1, $line2) = @_;
     for ($line1, $line2) {
!       ## remove filenames from error messages to avoid any
!       ## filepath naming differences between OS platforms
!       s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;
!       s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;
     }
!    return ($line1 ne $line2);
  }
  
  sub testpodcheck( @ ) {
diff -rcN PodParser-1.12/lib/Pod/Find.pm PodParser-1.13/lib/Pod/Find.pm
*** PodParser-1.12/lib/Pod/Find.pm	Sun Mar 12 00:51:11 2000
--- PodParser-1.13/lib/Pod/Find.pm	Tue Mar 14 11:01:29 2000
***************
*** 13,19 ****
  package Pod::Find;
  
  use vars qw($VERSION);
! $VERSION = 0.11;   ## Current version of this package
  require  5.005;    ## requires this Perl version or later
  
  #############################################################################
--- 13,19 ----
  package Pod::Find;
  
  use vars qw($VERSION);
! $VERSION = 0.12;   ## Current version of this package
  require  5.005;    ## requires this Perl version or later
  
  #############################################################################
***************
*** 49,61 ****
  
  A warning is printed if more than one POD file with the same POD name
  is found, e.g. F<CPAN.pm> in different directories. This usually
! indicates duplicate occurences of modules in the I<@INC> search path.
  
  The function B<simplify_name> is equivalent to B<basename>, but also
! strips Perl-like extensions (.pm, .pl, .pod).
  
  Note that neither B<pod_find> nor B<simplify_name> are exported by
! default so be sure to specify them in the B<use> statement if you need them:
  
    use Pod::Find qw(pod_find simplify_name);
  
--- 49,63 ----
  
  A warning is printed if more than one POD file with the same POD name
  is found, e.g. F<CPAN.pm> in different directories. This usually
! indicates duplicate occurrences of modules in the I<@INC> search path.
  
  The function B<simplify_name> is equivalent to B<basename>, but also
! strips Perl-like extensions (.pm, .pl, .pod) and extensions like
! F<.bat>, F<.cmd> on Win32 and OS/2, respectively.
  
  Note that neither B<pod_find> nor B<simplify_name> are exported by
! default so be sure to specify them in the B<use> statement if you need
! them:
  
    use Pod::Find qw(pod_find simplify_name);
  
***************
*** 86,92 ****
  
  =item B<-inc>
  
! Search for PODs in the current Perl interpreter's I<@INC> paths.
  
  =back
  
--- 88,95 ----
  
  =item B<-inc>
  
! Search for PODs in the current Perl interpreter's I<@INC> paths. This
! automatically considers paths specified in the C<PERL5LIB> environment.
  
  =back
  
***************
*** 104,109 ****
--- 107,113 ----
  use strict;
  #use diagnostics;
  use Exporter;
+ use File::Spec;
  use File::Find;
  use Cwd;
  
***************
*** 144,150 ****
          require Config;
          # this code simplifies the POD name for Perl modules:
          # * remove "site_perl"
!         # * remove e.g. "i586-linux"
          # * remove e.g. 5.00503
          # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
          $SIMPLIFY_RX =
--- 148,154 ----
          require Config;
          # this code simplifies the POD name for Perl modules:
          # * remove "site_perl"
!         # * remove e.g. "i586-linux" (from 'archname')
          # * remove e.g. 5.00503
          # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
          $SIMPLIFY_RX =
***************
*** 158,168 ****
      my $pwd = cwd();
  
      foreach my $try (@search) {
!         unless($try =~ m:^/:s) {
! 	    # make path absolute
! 	    $try = join('/',$pwd,$try);
! 	}
! 	$try =~ s:/\.?(?=/|\z)::; # simplify path
          my $name;
          if(-f $try) {
              if($name = _check_and_extract_name($try, $opts{-verbose})) {
--- 162,173 ----
      my $pwd = cwd();
  
      foreach my $try (@search) {
!         unless(File::Spec->file_name_is_absolute($try)) {
!             # make path absolute
!             $try = File::Spec->catfile($pwd,$try);
!         }
!         # simplify path
!         $try = File::Spec->canonpath($try);
          my $name;
          if(-f $try) {
              if($name = _check_and_extract_name($try, $opts{-verbose})) {
***************
*** 170,199 ****
              }
              next;
          }
! 	my $root_rx = qq!^\Q$try\E/!;
          File::Find::find( sub {
! 	    my $item = $File::Find::name;
! 	    if(-d) {
! 	        if($dirs_visited{$item}) {
! 		    warn "Directory '$item' already seen, skipping.\n"
! 		        if($opts{-verbose});
! 		    $File::Find::prune = 1;
! 		    return;
! 		}
! 		else {
! 	            $dirs_visited{$item} = 1;
! 		}
! 		if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
                      $File::Find::prune = 1;
                      warn "Perl $] version mismatch on $_, skipping.\n"
! 		        if($opts{-verbose});
! 		}
! 		return;
! 	    }
              if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
                  _check_for_duplicates($item, $name, \%names, \%pods);
              }
! 	}, $try); # end of File::Find::find
      }
      chdir $pwd;
      %pods;
--- 175,204 ----
              }
              next;
          }
!         my $root_rx = qq!^\Q$try\E/!;
          File::Find::find( sub {
!             my $item = $File::Find::name;
!             if(-d) {
!                 if($dirs_visited{$item}) {
!                     warn "Directory '$item' already seen, skipping.\n"
!                         if($opts{-verbose});
!                     $File::Find::prune = 1;
!                     return;
!                 }
!                 else {
!                     $dirs_visited{$item} = 1;
!                 }
!                 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
                      $File::Find::prune = 1;
                      warn "Perl $] version mismatch on $_, skipping.\n"
!                         if($opts{-verbose});
!                 }
!                 return;
!             }
              if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
                  _check_for_duplicates($item, $name, \%names, \%pods);
              }
!         }, $try); # end of File::Find::find
      }
      chdir $pwd;
      %pods;
***************
*** 203,210 ****
      my ($file, $name, $names_ref, $pods_ref) = @_;
      if($$names_ref{$name}) {
          warn "Duplicate POD found (shadowing?): $name ($file)\n";
! 	warn "    Already seen in ",
! 	    join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
      }
      else {
          $$names_ref{$name} = 1;
--- 208,215 ----
      my ($file, $name, $names_ref, $pods_ref) = @_;
      if($$names_ref{$name}) {
          warn "Duplicate POD found (shadowing?): $name ($file)\n";
!         warn "    Already seen in ",
!             join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
      }
      else {
          $$names_ref{$name} = 1;
***************
*** 215,229 ****
  sub _check_and_extract_name {
      my ($file, $verbose, $root_rx) = @_;
  
!     # check extension or executable
!     unless($file =~ /\.(pod|pm|pl)\z/i || (-f $file && -x _ && -T _)) {
          return undef;
      }
  
      # check for one line of POD
      unless(open(POD,"<$file")) {
          warn "Error: $file is unreadable: $!\n";
! 	return undef;
      }
      local $/ = undef;
      my $pod = <POD>;
--- 220,235 ----
  sub _check_and_extract_name {
      my ($file, $verbose, $root_rx) = @_;
  
!     # check extension or executable flag
!     # this involves testing the .bat extension on Win32!
!     unless($file =~ /\.(pod|pm|plx?)\z/i || (-f $file && -x _ && -T _)) {
          return undef;
      }
  
      # check for one line of POD
      unless(open(POD,"<$file")) {
          warn "Error: $file is unreadable: $!\n";
!         return undef;
      }
      local $/ = undef;
      my $pod = <POD>;
***************
*** 245,252 ****
      else {
          $name =~ s:^.*/::s;
      }
!     $name =~ s/\.(pod|pm|pl)\z//i;
!     $name =~ s!/+!::!g;
      $name;
  }
  
--- 251,258 ----
      else {
          $name =~ s:^.*/::s;
      }
!     _simplify($name);
!     $name =~ s!/+!::!g; #/
      $name;
  }
  
***************
*** 254,262 ****
  # basename & strip extension
  sub simplify_name {
      my ($str) = @_;
      $str =~ s:^.*/::s;
!     $str =~ s:\.p([lm]|od)\z::i;
      $str;
  }
  
  1;
--- 260,277 ----
  # basename & strip extension
  sub simplify_name {
      my ($str) = @_;
+     # remove all path components
      $str =~ s:^.*/::s;
!     _simplify($str);
      $str;
+ }
+ 
+ # internal sub only
+ sub _simplify {
+     # strip Perl's own extensions
+     $_[0] =~ s/\.(pod|pm|plx?)\z//i;
+     # strip meaningless extensions on Win32 and OS/2
+     $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /win|os2/i);
  }
  
  1;



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About