W3C home > Mailing lists > Public > www-validator-cvs@w3.org > June 2006

perl/modules/W3C/LinkChecker/bin checklink,4.35,4.36

From: Ville Skytta via cvs-syncmail <cvsmail@w3.org>
Date: Thu, 15 Jun 2006 17:57:29 +0000
To: www-validator-cvs@w3.org
Message-Id: <E1Fqw5x-0000hC-6B@lionel-hutz.w3.org>

Update of /sources/public/perl/modules/W3C/LinkChecker/bin
In directory hutz:/tmp/cvs-serv2615

Modified Files:
	checklink 
Log Message:
Update mod_perl HTTP_AUTHORIZATION hack for recent 2.x, drop support for 1.x.

Index: checklink
===================================================================
RCS file: /sources/public/perl/modules/W3C/LinkChecker/bin/checklink,v
retrieving revision 4.35
retrieving revision 4.36
diff -u -d -r4.35 -r4.36
--- checklink	15 Jun 2006 17:53:14 -0000	4.35
+++ checklink	15 Jun 2006 17:57:27 -0000	4.36
@@ -116,6 +116,9 @@
 
 use constant LINE_UNKNOWN  => -1;
 
+use constant MP2 =>
+  (exists($ENV{MOD_PERL_API_VERSION}) && $ENV{MOD_PERL_API_VERSION} >= 2);
+
 @W3C::LinkChecker::ISA =  qw(HTML::Parser);
 
 BEGIN
@@ -130,10 +133,10 @@
                          $PROGRAM, $VERSION, $cvsver, LWP::RobotUA->_agent());
 
   # Pull in mod_perl modules if applicable.
-  if ($ENV{MOD_PERL}) {
-    eval "require Apache2::compat"; # For mod_perl 2
-    require Apache;
-  }
+  eval {
+    local $SIG{__DIE__};
+    require Apache2::RequestUtil;
+  } if MP2();
 
   my @content_types = qw(application/xhtml+xml text/html);
   $Accept = join(', ', @content_types) . ', */*;q=0.5';
@@ -388,10 +391,11 @@
 
   # All Apache configurations don't set HTTP_AUTHORIZATION for CGI scripts.
   # If we're under mod_perl, there is a way around it...
-  if ($ENV{MOD_PERL}) {
-    my $auth = Apache->request()->header_in('Authorization');
-    $ENV{HTTP_AUTHORIZATION} ||= $auth if $auth;
-  }
+  eval {
+    local $SIG{__DIE__};
+    my $auth = Apache2::RequestUtil->request()->headers_in()->{Authorization};
+    $ENV{HTTP_AUTHORIZATION} = $auth if $auth;
+  } if (MP2() && !$ENV{HTTP_AUTHORIZATION});
 
   $uri =~ s/^\s+//g;
   if ($uri =~ m/^file:/) {
Received on Thursday, 15 June 2006 17:57:37 UTC

This archive was generated by hypermail 2.4.0 : Friday, 17 January 2020 23:02:17 UTC