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

r=glob, a=mkanat

2 files changed, 7 insertions, 15 deletions

diff --git a/Bugzilla/Constants.pm b/Bugzilla/Constants.pm
index d626c9749..4a39110fa 100644
--- a/Bugzilla/Constants.pm
+++ b/Bugzilla/Constants.pm
@@ -149,6 +149,7 @@ use File::Basename;
     DB_MODULE
     ROOT_USER
     ON_WINDOWS
+    ON_ACTIVESTATE
 
     MAX_TOKEN_AGE
     MAX_LOGINCOOKIE_AGE
@@ -471,6 +472,8 @@ use constant DB_MODULE => {
 
 # True if we're on Win32.
 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
 # instructions to Bugzilla administrators.
diff --git a/Bugzilla/Install/Requirements.pm b/Bugzilla/Install/Requirements.pm
index dfdeafb70..34e93b675 100644
--- a/Bugzilla/Install/Requirements.pm
+++ b/Bugzilla/Install/Requirements.pm
@@ -376,17 +376,6 @@ sub _check_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 {
     my ($check_results, $output) = @_;
 
@@ -427,7 +416,7 @@ sub print_module_instructions {
     if ((!$output && @{$check_results->{missing}})
         || ($output && $check_results->{any_missing}))
     {
-        if (ON_WINDOWS) {
+        if (ON_ACTIVESTATE) {
             my $perl_ver = sprintf('%vd', $^V);
             
             # URL when running Perl 5.8.x.
@@ -439,7 +428,7 @@ sub print_module_instructions {
             print colored(install_string('ppm_repo_add', 
                                  { theory_url => $url_to_theory58S }), 'red');
             # 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');
             }
         }
@@ -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}) 
     {
         print install_string('install_all', { perl => $^X });
@@ -586,7 +575,7 @@ sub install_command {
     my $module = shift;
     my ($command, $package);
 
-    if (ON_WINDOWS) {
+    if (ON_ACTIVESTATE) {
         $command = 'ppm install %s';
         $package = $module->{package};
     }