patch, 6 partsgitweb: Some mod_perl specific support (but not only)

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index 65fcdb0..aaee217 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -1678,7 +1678,17 @@ sub blob_mimetype {
 }
 
 ## ======================================================================
-## functions printing HTML: header, footer, error page
+## functions printing HTTP or HTML: header, footer, error page
+
+sub http_header {
+	my @header = @_;
+
+	print $cgi->header(@header);
+
+	# Optimization: skip generating the body if client asks only
+	# for HTTP header (e.g. cache validation).
+	return if ($cgi->request_method() eq 'HEAD');
+}
 
 sub git_header_html {
 	my $status = shift || "200 OK";
@@ -1709,8 +1719,11 @@ sub git_header_html {
 	} else {
 		$content_type = 'text/html';
 	}
-	print $cgi->header(-type=>$content_type, -charset => 'utf-8',
-	                   -status=> $status, -expires => $expires);
+	http_header(
+		-type => $content_type,
+		-charset => 'utf-8',
+		-status => $status,
+		-expires => $expires);
 	print <<EOF;
 <?xml version="1.0" encoding="utf-8"?>
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
@@ -2983,7 +2996,7 @@ sub git_forks {
 sub git_project_index {
 	my @projects = git_get_projects_list($project);
 
-	print $cgi->header(
+	http_header(
 		-type => 'text/plain',
 		-charset => 'utf-8',
 		-content_disposition => 'inline; filename="index.aux"');
@@ -3375,7 +3388,7 @@ sub git_blob_plain {
 		$save_as .= '.txt';
 	}
 
-	print $cgi->header(
+	http_header(
 		-type => "$type",
 		-expires=>$expires,
 		-content_disposition => 'inline; filename="' . "$save_as" . '"');
@@ -3591,10 +3604,9 @@ sub git_snapshot {
 
 	my $filename = basename($project) . "-$hash.tar.$suffix";
 
-	print $cgi->header(
+	http_header(
 		-type => "application/$ctype",
-		-content_disposition => 'inline; filename="' . "$filename" . '"',
-		-status => '200 OK');
+		-content_disposition => 'inline; filename="' . "$filename" . '"');
 
 	my $git = git_cmd_str();
 	my $name = $project;
@@ -3979,7 +3991,7 @@ sub git_blobdiff {
 		}
 
 	} elsif ($format eq 'plain') {
-		print $cgi->header(
+		http_header(
 			-type => 'text/plain',
 			-charset => 'utf-8',
 			-expires => $expires,
@@ -4128,7 +4140,7 @@ sub git_commitdiff {
 		my $tagname = git_get_rev_name_tags($hash);
 		my $filename = basename($project) . "-$hash.patch";
 
-		print $cgi->header(
+		http_header(
 			-type => 'text/plain',
 			-charset => 'utf-8',
 			-expires => $expires,
@@ -4465,12 +4477,12 @@ sub git_feed {
 	if (defined($commitlist[0])) {
 		%latest_commit = %{$commitlist[0]};
 		%latest_date   = parse_date($latest_commit{'author_epoch'});
-		print $cgi->header(
+		http_header(
 			-type => $content_type,
 			-charset => 'utf-8',
 			-last_modified => $latest_date{'rfc2822'});
 	} else {
-		print $cgi->header(
+		http_header(
 			-type => $content_type,
 			-charset => 'utf-8');
 	}
@@ -4670,7 +4682,9 @@ sub git_atom {
 sub git_opml {
 	my @list = git_get_projects_list();
 
-	print $cgi->header(-type => 'text/xml', -charset => 'utf-8');
+	http_header(
+		-type => 'text/xml',
+		-charset => 'utf-8');
 	print <<XML;
 <?xml version="1.0" encoding="utf-8"?>
 <opml version="1.0">

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index aaee217..bb1d66c 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -1724,6 +1724,8 @@ sub git_header_html {
 		-charset => 'utf-8',
 		-status => $status,
 		-expires => $expires);
+	# the environmental variable MOD_PERL has 'mod_perl/VERSION' value if set
+	my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
 	print <<EOF;
 <?xml version="1.0" encoding="utf-8"?>
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
@@ -1732,7 +1734,7 @@ sub git_header_html {
 <!-- git core binaries version $git_version -->
 <head>
 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
-<meta name="generator" content="gitweb/$version git/$git_version"/>
+<meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
 <meta name="robots" content="index, nofollow"/>
 <title>$title</title>
 EOF

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index bb1d66c..3888563 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -18,6 +18,10 @@ use File::Find qw();
 use File::Basename qw(basename);
 binmode STDOUT, ':utf8';
 
+BEGIN {
+	CGI->compile() if $ENV{MOD_PERL};
+}
+
 our $cgi = new CGI;
 our $version = "++GIT_VERSION++";
 our $my_url = $cgi->url();

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index 3888563..9983e9e 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -18,10 +18,36 @@ use File::Find qw();
 use File::Basename qw(basename);
 binmode STDOUT, ':utf8';
 
+# Set the constant MP_GEN to 0 if mod_perl is not available,
+# to 1 if running under mod_perl 1.0
+# and 2 for mod_perl 2.0
+use constant {
+	MP_GEN => ($ENV{'MOD_PERL'}
+	           ? ( exists $ENV{'MOD_PERL_API_VERSION'} and 
+	                      $ENV{'MOD_PERL_API_VERSION'} >= 2 ) ? 2 : 1
+	           : 0),
+};
+
 BEGIN {
-	CGI->compile() if $ENV{MOD_PERL};
+	# use appropriate mod_perl modules (conditional use)
+	if (MP_GEN == 2) {
+		require Apache2::RequestRec;
+		require Apache2::Const;
+		Apache2::Const->import(-compile => qw(:common :http));
+	} elsif (MP_GEN == 1) {
+		require Apache;
+		require Apache::Constants;
+		Apache::Constants->import(qw(:common :http));
+	}
+
+	# precompile CGI for mod_perl
+	CGI->compile() if MP_GEN;
 }
 
+# mod_perl request
+my $r;
+$r = shift @_ if MP_GEN;
+
 our $cgi = new CGI;
 our $version = "++GIT_VERSION++";
 our $my_url = $cgi->url();

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index 9983e9e..2900ae6 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -32,11 +32,16 @@ BEGIN {
 	# use appropriate mod_perl modules (conditional use)
 	if (MP_GEN == 2) {
 		require Apache2::RequestRec;
+		require Apache2::ServerRec;
+		require Apache2::Response;
 		require Apache2::Const;
+		Apache2::RequestRec->import();
+		Apache2::ServerRec->import();
 		Apache2::Const->import(-compile => qw(:common :http));
 	} elsif (MP_GEN == 1) {
 		require Apache;
 		require Apache::Constants;
+		import Apache;
 		Apache::Constants->import(qw(:common :http));
 	}
 
@@ -48,7 +53,15 @@ BEGIN {
 my $r;
 $r = shift @_ if MP_GEN;
 
-our $cgi = new CGI;
+our $cgi;
+if ((MP_GEN == 1 && $CGI::VERSION >= 2.93) ||
+    (MP_GEN == 2 && $CGI::VERSION >= 3.11)) {
+	# CGI.pm is new enough
+	$cgi = new CGI($r);
+} else {
+	$cgi = new CGI;
+}
+
 our $version = "++GIT_VERSION++";
 our $my_url = $cgi->url();
 our $my_uri = $cgi->url(-absolute => 1);
@@ -70,7 +83,8 @@ our $home_link_str = "++GITWEB_HOME_LINK_STR++";
 # name of your site or organization to appear in page titles
 # replace this with something more descriptive for clearer bookmarks
 our $site_name = "++GITWEB_SITENAME++"
-                 || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
+                 || (($r ? $r->server()->server_hostname() : $ENV{'SERVER_NAME'})
+                     || "Untitled") . " Git";
 
 # filename of html text to include at top of each page
 our $site_header = "++GITWEB_SITE_HEADER++";
@@ -403,7 +417,7 @@ if (defined $searchtype) {
 # now read PATH_INFO and use it as alternative to parameters
 sub evaluate_path_info {
 	return if defined $project;
-	my $path_info = $ENV{"PATH_INFO"};
+	my $path_info = $r ? $r->path_info() : $ENV{'PATH_INFO'};
 	return if !$path_info;
 	$path_info =~ s,^/+,,;
 	return if !$path_info;

diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
index 2900ae6..12f1cb2 100755
--- a/gitweb/gitweb.perl
+++ b/gitweb/gitweb.perl
@@ -35,13 +35,17 @@ BEGIN {
 		require Apache2::ServerRec;
 		require Apache2::Response;
 		require Apache2::Const;
+		require APR::Date;
 		Apache2::RequestRec->import();
 		Apache2::ServerRec->import();
 		Apache2::Const->import(-compile => qw(:common :http));
+		APR::Date->import();
 	} elsif (MP_GEN == 1) {
 		require Apache;
 		require Apache::Constants;
+		require Apache::File;
 		import Apache;
+		import Apache::File;
 		Apache::Constants->import(qw(:common :http));
 	}
 
@@ -1727,11 +1731,129 @@ sub blob_mimetype {
 sub http_header {
 	my @header = @_;
 
-	print $cgi->header(@header);
+	if (MP_GEN) {
+		my %header = @header;
+		my $cache_validator;
+
+		## special cases ##
+		# -status
+		$r->status_line($header{-status})
+			if $header{-status};
+		delete $header{-status} if exists $header{-status};
+		# -type and -charset
+		if ($header{-type} || $header{-charset}) {
+			my $type = $header{-type} || 'text/html';
+			$type .= "; charset=$header{-charset}"
+				if $type =~ m!^text/! and $type !~ /\bcharset\b/ and $header{-charset};
+
+			$r->content_type($type);
+		}
+		delete $header{-type} if exists $header{-type};
+		delete $header{-charset} if exists $header{-charset};
+		# -content_encoding
+		$r->content_encoding($header{-content_encoding})
+			if $header{-content_encoding};
+		delete $header{-content_encoding} if exists $header{-content_encoding};
+		# -expires
+		if ($header{-expires}) {
+			my $expires = CGI::Util::expires($header{-expires}, 'http');
+			if (MP_GEN == 1) {
+				$r->header_out('Expires', $expires);
+			} else {
+				$r->headers_out->add('Expires', $expires);
+			}
+		}
+		delete $header{-expires} if exists $header{-expires};
+		# -last_modified
+		if ($header{-last_modified}) {
+			$cache_validator ||= 1;
+			if (MP_GEN == 1) {
+				$r->header_out('Last-Modified', $header{-last_modified});
+			} else {
+				$r->set_last_modified(APR::Date::parse_http($header{-last_modified}));
+			}
+		}
+		delete $header{-last_modified} if exists $header{-last_modified};
+
+		## other headers ##
+		while (my ($key, $value) = each %header) {
+			$key =~ s/^-//; # -content_disposition -> content_disposition
+			$key =~ s/_/-/; #  content_disposition -> content-disposition
+			$key =~ s/(\w)(\w*)/\u$1$2/g;
+			                #  content-disposition -> Content-Disposition
+
+			if (MP_GEN == 1) {
+				$r->header_out($key, $value);
+			} else {
+				$r->headers_out->add($key, $value);
+			}
+		}
+		$cache_validator ||= (exists $header{-ETag} || exists $header{-etag});
+
+		## send headers / flush ##
+		if (MP_GEN == 1) {
+			$r->send_http_headers();
+
+			## validate cache ##
+			if ($cache_validator &&
+			    (my $rc = $r->meets_conditions()) != Apache::Constant::OK) {
+				return $rc;
+			}
+		} else {
+			$r->rflush();
+
+			## validate cache ##
+			if ($cache_validator &&
+			    (my $rc = $r->meets_conditions()) != Apache2::Const::OK) {
+				return $rc;
+			}
+		}
+	} else {
+		print $cgi->header(@header);
+	}
 
 	# Optimization: skip generating the body if client asks only
 	# for HTTP header (e.g. cache validation).
-	return if ($cgi->request_method() eq 'HEAD');
+	if (MP_GEN == 2) {
+		return Apache2::Const::OK   if $r->header_only();
+	} elsif (MP_GEN == 1) {
+		return Apache::Constant::OK if $r->header_only();
+	} else {
+		return if ($cgi->request_method() eq 'HEAD');
+	}
+}
+
+sub http_redirect {
+	my @params = @_;
+	my %params;
+	if (@params % 2 == 0) {
+		%params = @params;
+	}
+	my $uri = $params{-uri} || $params{-url} || $params{-location}
+		|| $params[0] || $cgi->self_url;
+	my $status = $params{-status};
+
+	if (MP_GEN == 1) {
+		$r->header_out('Location', $uri);
+		if (defined $status) {
+			$r->status_line($status);
+		} else {
+			$r->status(Apache::Constant::REDIRECT);
+		}
+
+		$r->send_http_headers();
+	} elsif (MP_GEN == 2) {
+		$r->headers_out->add('Location', $uri);
+		if (defined $status) {
+			$r->status_line($status);
+		} else {
+			$r->status(Apache2::Const::REDIRECT);
+		}
+
+		$r->rflush();
+	} else {
+		print $cgi->redirect(@params);
+	}
 }
 
 sub git_header_html {
@@ -1854,7 +1976,8 @@ EOF
 		      $cgi->hidden(-name => "a") . "\n" .
 		      $cgi->hidden(-name => "h") . "\n" .
 		      $cgi->popup_menu(-name => 'st', -default => 'commit',
-				       -values => ['commit', 'author', 'committer', 'pickaxe']) .
+		                       -values => ['commit', 'author', 'committer',
+		                       gitweb_check_feature('pickaxe') ? 'pickaxe' : ()]) .
 		      $cgi->sup($cgi->a({-href => href(action=>"search_help")}, "?")) .
 		      " search:\n",
 		      $cgi->textfield(-name => "s", -value => $searchtext) . "\n" .
@@ -3901,10 +4024,10 @@ sub git_object {
 		die_error('404 Not Found', "Not enough information to find object");
 	}
 
-	print $cgi->redirect(-uri => href(action=>$type, -full=>1,
-	                                  hash=>$hash, hash_base=>$hash_base,
-	                                  file_name=>$file_name),
-	                     -status => '302 Found');
+	http_redirect(-uri => href(action=>$type, -full=>1,
+	                           hash=>$hash, hash_base=>$hash_base,
+	                           file_name=>$file_name),
+	              -status => '302 Found');
 }
 
 sub git_blobdiff {