[Module-build-checkins] [svn:Module-Build] r6010 - in Module-Build/trunk: . lib/Module/Build lib/Module/Build/Platform

[<kwi...@cv...>]

Author: kwilliams
Date: Tue May  2 16:21:40 2006
New Revision: 6010

Modified:
   Module-Build/trunk/Changes
   Module-Build/trunk/lib/Module/Build/Base.pm
   Module-Build/trunk/lib/Module/Build/Platform/Unix.pm

Log:
Use stat() on Unix, -x everywhere else.

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Tue May  2 16:21:40 2006
@@ -1,5 +1,11 @@
 Revision history for Perl extension Module::Build.
 
+0.2801
+
+ - Tweaked the way we determine whether a file is executable on Unix.
+   We use this determination to decide whether to make it executable
+   during installation. [Julian Mehnle]
+
 0.28  Thu Apr 27 22:25:00 CDT 2006
 
  - When y_n() or prompt() are called without a default value and the

Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm	Tue May  2 16:21:40 2006
@@ -1272,6 +1272,13 @@
   }
 }
 
+sub is_executable {
+  # We assume this does the right thing on generic platforms, though
+  # we do some other more specific stuff on Unixish platforms.
+  my ($self, $file) = @_;
+  return -x $file;
+}
+
 sub _startperl { shift()->config('startperl') }
 
 # Return any directories in @INC which are not in the default @INC for
@@ -3955,7 +3962,7 @@
   $self->log_info("$file -> $to_path\n") if $args{verbose};
   File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
   # mode is read-only + (executable if source is executable)
-  my $mode = 0444 | ( -x $file ? 0111 : 0 );
+  my $mode = 0444 | ( $self->is_executable($file) ? 0111 : 0 );
   chmod( $mode, $to_path );
 
   return $to_path;

Modified: Module-Build/trunk/lib/Module/Build/Platform/Unix.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Platform/Unix.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Platform/Unix.pm	Tue May  2 16:21:40 2006
@@ -13,6 +13,17 @@
   $self->SUPER::make_tarball(@_);
 }
 
+sub is_executable {
+  # We consider the owner bit to be authoritative on a file, because
+  # -x will always return true if the user is root and *any*
+  # executable bit is set.  The -x test seems to try to answer the
+  # question "can I execute this file", but I think we want "is this
+  # file executable".
+
+  my ($self, $file) = @_;
+  return +(stat $file)[2] & 0100;
+}
+
 sub _startperl { "#! " . shift()->perl }
 
 sub _construct {