r5343 - in /packages/libapache-dbilogger-perl/trunk: DBILogger.pm
debian/changelog
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Wed May 2 02:39:27 UTC 2007
Author: gwolf
Date: Wed May 2 02:39:27 2007
New Revision: 5343
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5343
Log:
Patched around the API incompatibility - This module now works again
under Apache 2.x / mod_perl 2.x!
Modified:
packages/libapache-dbilogger-perl/trunk/DBILogger.pm
packages/libapache-dbilogger-perl/trunk/debian/changelog
Modified: packages/libapache-dbilogger-perl/trunk/DBILogger.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libapache-dbilogger-perl/trunk/DBILogger.pm?rev=5343&op=diff
==============================================================================
--- packages/libapache-dbilogger-perl/trunk/DBILogger.pm (original)
+++ packages/libapache-dbilogger-perl/trunk/DBILogger.pm Wed May 2 02:39:27 2007
@@ -2,7 +2,25 @@
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 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"));
@@ -94,8 +94,73 @@
# #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 at 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;
@@ -267,6 +332,19 @@
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 at 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
Modified: packages/libapache-dbilogger-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libapache-dbilogger-perl/trunk/debian/changelog?rev=5343&op=diff
==============================================================================
--- packages/libapache-dbilogger-perl/trunk/debian/changelog (original)
+++ packages/libapache-dbilogger-perl/trunk/debian/changelog Wed May 2 02:39:27 2007
@@ -1,3 +1,10 @@
+libapache-dbilogger-perl (0.93-9) unstable; urgency=low
+
+ * Ported the module to correctly work under Apache 2.x / mod_perl 2.x,
+ as it is API-incompatible (Closes: #397491)
+
+ -- Gunnar Wolf <gwolf at localdomain> Tue, 01 May 2007 21:36:09 -0500
+
libapache-dbilogger-perl (0.93-8) unstable; urgency=low
* Removed spurious file with a temporary commit message (Closes:
More information about the Pkg-perl-cvs-commits
mailing list