This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid runtime module loading in File::Spec
authorZefram <zefram@fysh.org>
Sat, 11 Nov 2017 10:05:53 +0000 (10:05 +0000)
committerZefram <zefram@fysh.org>
Sat, 11 Nov 2017 10:05:53 +0000 (10:05 +0000)
Incidentally remove the ->_cwd method from the subclassing interface of
File::Spec::Unix, in favour of direct calls to Cwd::getcwd().

dist/PathTools/Changes
dist/PathTools/lib/File/Spec/Mac.pm
dist/PathTools/lib/File/Spec/OS2.pm
dist/PathTools/lib/File/Spec/Unix.pm
dist/PathTools/lib/File/Spec/VMS.pm
dist/PathTools/lib/File/Spec/Win32.pm
dist/PathTools/t/Spec.t

index b145794..c2ee7c1 100644 (file)
@@ -1,5 +1,9 @@
 Revision history for Perl distribution PathTools.
 
+3.69
+- avoid loading modules repeatedly at runtime
+- replace 'use vars' by 'our'
+
 3.68
 - avoid warning from pre-5.8 code for detecting tainted values
 - make taint.t detect that a pre-5.8 Perl supports tainting
index 082b9b8..345a829 100644 (file)
@@ -1,6 +1,7 @@
 package File::Spec::Mac;
 
 use strict;
+use Cwd ();
 require File::Spec::Unix;
 
 our $VERSION = '3.69';
@@ -668,7 +669,7 @@ sub abs2rel {
 
     # Figure out the effective $base and clean it up.
     if ( !defined( $base ) || $base eq '' ) {
-       $base = $self->_cwd();
+       $base = Cwd::getcwd();
     }
     elsif ( ! $self->file_name_is_absolute( $base ) ) {
         $base = $self->rel2abs( $base ) ;
@@ -736,7 +737,7 @@ sub rel2abs {
     if ( ! $self->file_name_is_absolute($path) ) {
         # Figure out the effective $base and clean it up.
         if ( !defined( $base ) || $base eq '' ) {
-           $base = $self->_cwd();
+           $base = Cwd::getcwd();
         }
         elsif ( ! $self->file_name_is_absolute($base) ) {
             $base = $self->rel2abs($base) ;
index b126c27..6af4bf1 100644 (file)
@@ -1,6 +1,7 @@
 package File::Spec::OS2;
 
 use strict;
+use Cwd ();
 require File::Spec::Unix;
 
 our $VERSION = '3.69';
@@ -29,11 +30,6 @@ sub path {
     return @path;
 }
 
-sub _cwd {
-    # In OS/2 the "require Cwd" is unnecessary bloat.
-    return Cwd::sys_cwd();
-}
-
 sub tmpdir {
     my $cached = $_[0]->_cached_tmpdir(qw 'TMPDIR TEMP TMP');
     return $cached if defined $cached;
@@ -147,7 +143,7 @@ sub abs2rel {
 
     # Figure out the effective $base and clean it up.
     if ( !defined( $base ) || $base eq '' ) {
-       $base = $self->_cwd();
+       $base = Cwd::getcwd();
     } elsif ( ! $self->file_name_is_absolute( $base ) ) {
         $base = $self->rel2abs( $base ) ;
     } else {
@@ -204,7 +200,7 @@ sub rel2abs {
     if ( ! $self->file_name_is_absolute( $path ) ) {
 
         if ( !defined( $base ) || $base eq '' ) {
-           $base = $self->_cwd();
+           $base = Cwd::getcwd();
         }
         elsif ( ! $self->file_name_is_absolute( $base ) ) {
             $base = $self->rel2abs( $base ) ;
index eecd8c8..f5ffdac 100644 (file)
@@ -1,25 +1,11 @@
 package File::Spec::Unix;
 
 use strict;
+use Cwd ();
 
 our $VERSION = '3.69';
-my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
-#dont try to load XSLoader and DynaLoader only to ultimately fail on miniperl
-if(!defined &canonpath && defined &DynaLoader::boot_DynaLoader) {
-  eval {#eval is questionable since we are handling potential errors like
-        #"Cwd object version 3.48 does not match bootstrap parameter 3.50
-        #at lib/DynaLoader.pm line 216." by having this eval
-    if ( $] >= 5.006 ) {
-       require XSLoader;
-       XSLoader::load("Cwd", $xs_version);
-    } else {
-       require Cwd;
-    }
-  };
-}
-
 =head1 NAME
 
 File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
@@ -409,7 +395,7 @@ Based on code written by Shigio Yamaguchi.
 
 sub abs2rel {
     my($self,$path,$base) = @_;
-    $base = $self->_cwd() unless defined $base and length $base;
+    $base = Cwd::getcwd() unless defined $base and length $base;
 
     ($path, $base) = map $self->canonpath($_), $path, $base;
 
@@ -436,7 +422,7 @@ sub abs2rel {
        }
     }
     else {
-       my $wd= ($self->splitpath($self->_cwd(), 1))[1];
+       my $wd= ($self->splitpath(Cwd::getcwd(), 1))[1];
        $path_directories = $self->catdir($wd, $path);
        $base_directories = $self->catdir($wd, $base);
     }
@@ -519,7 +505,7 @@ sub rel2abs {
     if ( ! $self->file_name_is_absolute( $path ) ) {
         # Figure out the effective $base and clean it up.
         if ( !defined( $base ) || $base eq '' ) {
-           $base = $self->_cwd();
+           $base = Cwd::getcwd();
         }
         elsif ( ! $self->file_name_is_absolute( $base ) ) {
             $base = $self->rel2abs( $base ) ;
@@ -552,15 +538,6 @@ L<File::Spec>
 
 =cut
 
-# Internal routine to File::Spec, no point in making this public since
-# it is the standard Cwd interface.  Most of the platform-specific
-# File::Spec subclasses use this.
-sub _cwd {
-    require Cwd;
-    Cwd::getcwd();
-}
-
-
 # Internal method to reduce xx\..\yy -> yy
 sub _collapse {
     my($fs, $path) = @_;
index 5b32027..f48d24c 100644 (file)
@@ -1,6 +1,7 @@
 package File::Spec::VMS;
 
 use strict;
+use Cwd ();
 require File::Spec::Unix;
 
 our $VERSION = '3.69';
@@ -441,7 +442,7 @@ sub abs2rel {
     my $self = shift;
     my($path,$base) = @_;
 
-    $base = $self->_cwd() unless defined $base and length $base;
+    $base = Cwd::getcwd() unless defined $base and length $base;
 
     # If there is no device or directory syntax on $base, make sure it
     # is treated as a directory.
@@ -513,7 +514,7 @@ sub rel2abs {
     if ( ! $self->file_name_is_absolute( $path ) ) {
         # Figure out the effective $base and clean it up.
         if ( !defined( $base ) || $base eq '' ) {
-            $base = $self->_cwd;
+            $base = Cwd::getcwd();
         }
         elsif ( ! $self->file_name_is_absolute( $base ) ) {
             $base = $self->rel2abs( $base ) ;
index a62e594..6cdb44e 100644 (file)
@@ -2,6 +2,7 @@ package File::Spec::Win32;
 
 use strict;
 
+use Cwd ();
 require File::Spec::Unix;
 
 our $VERSION = '3.69';
@@ -329,14 +330,13 @@ sub rel2abs {
 
     if ($is_abs) {
       # It's missing a volume, add one
-      my $vol = ($self->splitpath( $self->_cwd() ))[0];
+      my $vol = ($self->splitpath( Cwd::getcwd() ))[0];
       return $self->canonpath( $vol . $path );
     }
 
     if ( !defined( $base ) || $base eq '' ) {
-      require Cwd ;
       $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
-      $base = $self->_cwd() unless defined $base ;
+      $base = Cwd::getcwd() unless defined $base ;
     }
     elsif ( ! $self->file_name_is_absolute( $base ) ) {
       $base = $self->rel2abs( $base ) ;
index 2982b8c..643f4a0 100644 (file)
@@ -285,7 +285,7 @@ my @tests = (
 [ "Win32->canonpath('/..\\')",          '\\'                  ],
 [ "Win32->canonpath('d1/../foo')",      'foo'                 ],
 
-# FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta
+# FakeWin32 subclass (see below) just sets getcwd() to C:\one\two and getdcwd('D') to D:\alpha\beta
 
 [ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')",     '.'                      ],
 [ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')",     '..\\t4'                 ],
@@ -798,14 +798,10 @@ my @tests = (
 
 ) ;
 
-can_ok('File::Spec::Win32', '_cwd');
-
 {
     package File::Spec::FakeWin32;
     our @ISA = qw(File::Spec::Win32);
 
-    sub _cwd { 'C:\\one\\two' }
-
     # Some funky stuff to override Cwd::getdcwd() for testing purposes,
     # in the limited scope of the rel2abs() method.
     if ($Cwd::VERSION && $Cwd::VERSION gt '2.17') {  # Avoid a 'used only once' warning
@@ -813,6 +809,8 @@ can_ok('File::Spec::Win32', '_cwd');
        *rel2abs = sub {
            my $self = shift;
            local $^W;
+           local *Cwd::getcwd = sub { 'C:\\one\\two' };
+           *Cwd::getcwd = *Cwd::getcwd; # Avoid a 'used only once' warning
            local *Cwd::getdcwd = sub {
              return 'D:\alpha\beta' if $_[0] eq 'D:';
              return 'C:\one\two'    if $_[0] eq 'C:';
@@ -822,6 +820,14 @@ can_ok('File::Spec::Win32', '_cwd');
            return $self->SUPER::rel2abs(@_);
        };
        *rel2abs = *rel2abs; # Avoid a 'used only once' warning
+       *abs2rel = sub {
+           my $self = shift;
+           local $^W;
+           local *Cwd::getcwd = sub { 'C:\\one\\two' };
+           *Cwd::getcwd = *Cwd::getcwd; # Avoid a 'used only once' warning
+           return $self->SUPER::abs2rel(@_);
+       };
+       *abs2rel = *abs2rel; # Avoid a 'used only once' warning
     }
 }