From 9cd7cb75046ae91f7dc7a3977b8d85886227a2b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Buclin?= <LpSolit@gmail.com>
Date: Wed, 30 Sep 2015 20:27:44 +0200
Subject: Bug 987742: Strawberry Perl requires C:\strawberry\c\bin\ to be in
 $ENV{PATH} to correctly load XS modules r=gerv a=dkl

---
 Bugzilla.pm | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/Bugzilla.pm b/Bugzilla.pm
index 3f4d31101..aa78f1483 100644
--- a/Bugzilla.pm
+++ b/Bugzilla.pm
@@ -82,19 +82,27 @@ sub init_page {
     }
 
     if (${^TAINT}) {
-        # Some environment variables are not taint safe
-        delete @::ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
-        # Some modules throw undefined errors (notably File::Spec::Win32) if
-        # PATH is undefined.
-        $ENV{'PATH'} = '';
-        # On Windows, these paths are tainted, preventing File::Spec::Win32->tmpdir
-        # from using them. But we need a place to temporary store attachments
-        # which are uploaded.
+        my $path = '';
         if (ON_WINDOWS) {
+            # On Windows, these paths are tainted, preventing
+            # File::Spec::Win32->tmpdir from using them. But we need
+            # a place to temporary store attachments which are uploaded.
             foreach my $temp (qw(TMPDIR TMP TEMP)) {
                 trick_taint($ENV{$temp}) if $ENV{$temp};
             }
+            # Some DLLs used by Strawberry Perl are also in c\bin,
+            # see https://rt.cpan.org/Public/Bug/Display.html?id=99104
+            if (!ON_ACTIVESTATE) {
+                my $c_path = $path = dirname($^X);
+                $c_path =~ s/\bperl\b(?=\\bin)/c/;
+                $path .= ";$c_path";
+            }
         }
+        # Some environment variables are not taint safe
+        delete @::ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+        # Some modules throw undefined errors (notably File::Spec::Win32) if
+        # PATH is undefined.
+        $ENV{'PATH'} = $path;
     }
 
     # Because this function is run live from perl "use" commands of
-- 
cgit v1.2.1