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 {
|
