Commit 0b85419f authored by Max Kanat-Alexander's avatar Max Kanat-Alexander

Bug 547336: Make installation work on Windows with Strawberry Perl Professional

r=glob, a=mkanat
parent 2f34ebff
...@@ -149,6 +149,7 @@ use File::Basename; ...@@ -149,6 +149,7 @@ use File::Basename;
DB_MODULE DB_MODULE
ROOT_USER ROOT_USER
ON_WINDOWS ON_WINDOWS
ON_ACTIVESTATE
MAX_TOKEN_AGE MAX_TOKEN_AGE
MAX_LOGINCOOKIE_AGE MAX_LOGINCOOKIE_AGE
...@@ -471,6 +472,8 @@ use constant DB_MODULE => { ...@@ -471,6 +472,8 @@ use constant DB_MODULE => {
# True if we're on Win32. # True if we're on Win32.
use constant ON_WINDOWS => ($^O =~ /MSWin32/i); use constant ON_WINDOWS => ($^O =~ /MSWin32/i);
# True if we're using ActiveState Perl (as opposed to Strawberry) on Windows.
use constant ON_ACTIVESTATE => eval { &Win32::BuildNumber };
# The user who should be considered "root" when we're giving # The user who should be considered "root" when we're giving
# instructions to Bugzilla administrators. # instructions to Bugzilla administrators.
......
...@@ -376,17 +376,6 @@ sub _check_missing { ...@@ -376,17 +376,6 @@ sub _check_missing {
return \@missing; return \@missing;
} }
# Returns the build ID of ActivePerl. If several versions of
# ActivePerl are installed, it won't be able to know which one
# you are currently running. But that's our best guess.
sub _get_activestate_build_id {
eval 'use Win32::TieRegistry';
return 0 if $@;
my $key = Win32::TieRegistry->new('LMachine\Software\ActiveState\ActivePerl')
or return 0;
return $key->GetValue("CurrentVersion");
}
sub print_module_instructions { sub print_module_instructions {
my ($check_results, $output) = @_; my ($check_results, $output) = @_;
...@@ -427,7 +416,7 @@ sub print_module_instructions { ...@@ -427,7 +416,7 @@ sub print_module_instructions {
if ((!$output && @{$check_results->{missing}}) if ((!$output && @{$check_results->{missing}})
|| ($output && $check_results->{any_missing})) || ($output && $check_results->{any_missing}))
{ {
if (ON_WINDOWS) { if (ON_ACTIVESTATE) {
my $perl_ver = sprintf('%vd', $^V); my $perl_ver = sprintf('%vd', $^V);
# URL when running Perl 5.8.x. # URL when running Perl 5.8.x.
...@@ -439,7 +428,7 @@ sub print_module_instructions { ...@@ -439,7 +428,7 @@ sub print_module_instructions {
print colored(install_string('ppm_repo_add', print colored(install_string('ppm_repo_add',
{ theory_url => $url_to_theory58S }), 'red'); { theory_url => $url_to_theory58S }), 'red');
# ActivePerls older than revision 819 require an additional command. # ActivePerls older than revision 819 require an additional command.
if (_get_activestate_build_id() < 819) { if (ON_ACTIVESTATE < 819) {
print install_string('ppm_repo_up'); print install_string('ppm_repo_up');
} }
} }
...@@ -477,7 +466,7 @@ sub print_module_instructions { ...@@ -477,7 +466,7 @@ sub print_module_instructions {
} }
} }
if ($output && $check_results->{any_missing} && !ON_WINDOWS if ($output && $check_results->{any_missing} && !ON_ACTIVESTATE
&& !$check_results->{hide_all}) && !$check_results->{hide_all})
{ {
print install_string('install_all', { perl => $^X }); print install_string('install_all', { perl => $^X });
...@@ -586,7 +575,7 @@ sub install_command { ...@@ -586,7 +575,7 @@ sub install_command {
my $module = shift; my $module = shift;
my ($command, $package); my ($command, $package);
if (ON_WINDOWS) { if (ON_ACTIVESTATE) {
$command = 'ppm install %s'; $command = 'ppm install %s';
$package = $module->{package}; $package = $module->{package};
} }
......
...@@ -47,9 +47,12 @@ GetOptions(\%switch, 'all|a', 'upgrade-all|u', 'show-config|s', 'global|g', ...@@ -47,9 +47,12 @@ GetOptions(\%switch, 'all|a', 'upgrade-all|u', 'show-config|s', 'global|g',
pod2usage({ -verbose => 1 }) if $switch{'help'}; pod2usage({ -verbose => 1 }) if $switch{'help'};
if (ON_WINDOWS) { if (ON_ACTIVESTATE) {
print "\nYou cannot run this script on Windows. Please follow instructions\n"; print <<END;
print "given by checksetup.pl to install missing Perl modules.\n\n"; You cannot run this script when using ActiveState Perl. Please follow
the instructions given by checksetup.pl to install missing Perl modules.
END
exit; exit;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment