Description: Ported the module to correctly work under Apache 2.x / mod_perl
 2.x, as it is API-incompatible
Author: Gunnar Wolf <gwolf@debian.org>
Bug-Debian: https://bugs.debian.org/397491
Last-Update: 2007-05-01
Forwarded: unknown

--- a/DBILogger.pm
+++ b/DBILogger.pm
@@ -2,7 +2,25 @@ package Apache::DBILogger;
 
 require 5.004;
 use strict;
-use Apache::Constants qw( :common );
+# use Apache::Constants qw( :common );
+# In order to make this module compatible with either Apache 1.3.x or 2.2.x,
+# for which mod_perl has slightly different APIs, this BEGIN block serves the
+# same purpose as the previous 'use Apache::Constants qw(:common)' statement.
+my $modperl2;
+BEGIN {
+    eval "use Apache::Constants qw(:common);";
+    if ($@) {
+        eval "use Apache2::Const qw(:common);
+              use APR::Pool;
+              use APR::Table;
+              use Apache2::Connection;
+              use APR::SockAddr;";
+	$modperl2 = 1;
+	if ($@) {
+            die "Not under Apache, not under Apache2?\n$@";
+        }
+    }
+}
 use DBI;
 use Date::Format;
 
@@ -25,30 +43,12 @@ sub reconnect($$) {
 }
 
 sub logger {
-	my $r = shift->last;
+        my $r = _get_req(shift);
 
 	my $s = $r->server;
 	my $c = $r->connection;
 
-	my %data = (
-		    'server'	=> $s->server_hostname,
-		    'bytes'     => $r->bytes_sent,
-		    'filename'	=> $r->filename || '',
-		    'remotehost'=> $c->remote_host || '',
-		    'remoteip'  => $c->remote_ip || '',
-		    'status'    => $r->status || '',
-		    'urlpath'	=> $r->uri || '',
-		    'referer'	=> $r->header_in("Referer") || '',	
-		    'useragent'	=> $r->header_in('User-Agent') || '',
-		    'timeserved'=> time2str("%Y-%m-%d %X", time),
-		    'contenttype' => $r->content_type || ''
-	);
-
-	if (my $user = $c->user) {
-		$data{user} = $user;
-	}
-
-	$data{usertrack} = $r->notes('cookie') || '';
+	my %data = _get_data($r);
 
 	my $dbh = DBI->connect($r->dir_config("DBILogger_data_source"), $r->dir_config("DBILogger_username"), $r->dir_config("DBILogger_password"));
   
@@ -57,16 +57,12 @@ sub logger {
   		return DECLINED;
   	}
   	
-  	my @valueslist;
-  	
-  	foreach (keys %data) {
-		$data{$_} = $dbh->quote($data{$_});
-		push @valueslist, $data{$_};
-	}
-
 	my $table = $r->dir_config("DBILogger_table") || 'requests';
 
-	my $statement = "insert into $table (". join(',', keys %data) .") VALUES (". join(',', @valueslist) .")";
+        my @columns = map($dbh->quote_identifier($_), keys   %data);
+        my @values  = map($dbh->quote($_),            values %data);
+
+	my $statement = "INSERT INTO $table (" . join(', ', @columns) . ") VALUES (" . join(', ', @values ) . ")";
 
 	my $tries = 0;
 	
@@ -98,10 +94,75 @@ sub logger {
 # #perl pun: <q[merlyn]> windows is for users who can't handle the power of the mac.
 
 sub handler { 
-	shift->post_connection(\&logger);
+        _register_logger(shift);
+}
+
+############################################################
+# Multi-API compatibility functions follow
+#
+# _register_logger, _get_req and _get_data should take care of handling the
+# incompatibility between the mod_perl 1.x and 2.x APIs. They should do exactly
+# the same, although in a different way; they are based on
+# http://perl.apache.org/docs/2.0/user/porting/compat.html
+#
+# For any bugs regarding this code, please contact Gunnar Wolf
+# <gwolf@debian.org>.
+sub _register_logger {
+        my $r = shift;
+	if ($modperl2) {
+	        $r->pool->cleanup_register(\&logger, $r);
+	} else {
+		$r->post_connection(\&logger);
+	}
 	return OK;
 }
 
+sub _get_req {
+        return $modperl2 ? shift : shift->last;
+}
+
+sub _get_data {
+        my ($r, $s, $c, %data);
+	$r = shift;
+	$s = $r->server;
+	$c = $r->connection;
+
+	if ($modperl2) {
+	        %data = (
+			 'server'	=> $s->server_hostname,
+			 'bytes'        => $r->bytes_sent,
+			 'filename'	=> $r->filename || '',
+			 'remotehost'   => $c->get_remote_host || '',
+			 'remoteip'     => $c->remote_addr->ip_get || '',
+			 'status'       => $r->status || '',
+			 'urlpath'	=> $r->uri || '',
+			 'referer'	=> $r->headers_in->{'Referer'} || '',
+			 'useragent'	=> $r->headers_in->{'User-Agent'} || '',
+			 'timeserved'   => time2str("%Y-%m-%d %X", time),
+			 'contenttype'  => $r->content_type || '',
+			 'user'         => $r->user() || '',
+			 'usertrack'    => $r->notes->get('cookie') || ''
+			 );
+	} else {
+	        %data = (
+			 'server'	=> $s->server_hostname,
+			 'bytes'        => $r->bytes_sent,
+			 'filename'	=> $r->filename || '',
+			 'remotehost'   => $c->remote_host || '',
+			 'remoteip'     => $c->remote_ip || '',
+			 'status'       => $r->status || '',
+			 'urlpath'	=> $r->uri || '',
+			 'referer'	=> $r->header_in("Referer") || '',
+			 'useragent'	=> $r->header_in('User-Agent') || '',
+			 'timeserved'   => time2str("%Y-%m-%d %X", time),
+			 'contenttype'  => $r->content_type || '',
+			 'user'         => $c->user || '',
+			 'usertrack'    => $r->notes('cookie') || ''
+			 );
+	}
+	return %data;
+}
+
 1;
 __END__
 
@@ -139,6 +200,10 @@ CREATE TABLE requests (
   KEY timeserved_idx (timeserved)
 );
 
+Please note that for some databases (notably, PostgreSQL) you will need to
+double-quote the user column name (that is, to specify it as C<"user"
+varchar(15)>) in order for the database not to mistake it with a keyword.
+
 Its recommended that you include
 
 use Apache::DBI;
@@ -267,6 +332,19 @@ work fine with Apache::DBI.
 You might get problems with Apache 1.2.x. (Not supporting
 post_connection?)
 
+=head1 MOD_PERL 2 SUPPORT
+
+The official version of this module, as Ask Bjoern Hansen last modified
+it, lacks support for the API changes introduced with Apache 2.x and
+the corresponding mod_perl 2.x - Of course, this is quite understandable
+as this module was last updated in 1998 ;-) But anyway, the module does its
+job still quite fine, and users still require its functionality.
+
+For any help requests regarding this module on Apache 2 systems, contact
+Gunnar Wolf <gwolf@debian.org> directly. If your system is based on Debian
+GNU/Linux, you can use the regular Debian bugtracking facilities, as the
+multi-API patch was introduced specifically for Debian.
+
 =head1 SUPPORT
 
 This module is supported via the mod_perl mailinglist