sync with the trunk
git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/branches/clone-skip-unstable@267280 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/Changes b/Changes
index f1ee8f5..b32d9ea 100644
--- a/Changes
+++ b/Changes
@@ -12,6 +12,28 @@
=item 2.0.2-dev
+Fix an undefined warning in DSO builds when not using MP_APXS.
+[Nikolay Ananiev <ananiev@thegdb.com>]
+
+When running Makefile.PL with the MP_MAINTAINER=1 option
+add -Wdeclaration-after-statement if we are using gcc
+version 3.3.2 or higher and its not already part of the ccopts.
+[Philip M. Gollucci, Gozer]
+
+Several fixes to Apache2::Status
+[Philip M. Gollucci]
+
+When using Apache2::Reload and ReloadDebug is set to 'On',
+sort the output alphabetically [Philip M. Gollucci]
+
+croak in case a filter returns DECLINED after calling $f->read (as it
+is not supposed to happen) [Stas]
+
+another round of cygwin fixes [Nick *** <doink123@abv.bg>]
+
+Multiple fixes to make mod_perl 2.0 work with blead-perl (5.9.3+)
+[Stas]
+
t/modules/reload.t would fail if run more than 3 times, breaking
smokes [Gozer]
diff --git a/Makefile.PL b/Makefile.PL
index 520c696..61b8451 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -389,8 +389,17 @@
}
if ($build->is_dynamic) {
- warning "You'll need to add the following to httpd.conf:",
- " LoadModule perl_module modules/$build->{MODPERL_LIB_DSO}\n";
+ warning
+ "You'll need to add the following to httpd.conf:", "",
+ " LoadModule perl_module modules/$build->{MODPERL_LIB_DSO}", "",
+ "depending on your build, mod_perl might not live in",
+ "the modules/ directory.\n";
+ if ($build->{MP_APXS}) {
+ warning
+ "Check the results of", "",
+ " \$ $build->{MP_APXS} -q LIBEXECDIR", "",
+ "and adjust the LoadModule directive accordingly.\n";
+ }
}
$build->save;
diff --git a/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm b/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
index 20bec7b..de5b082 100644
--- a/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
+++ b/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
@@ -103,7 +103,7 @@
#########################################################################
sub new {
- my($class, $r) = @_;
+ my ($class, $r) = @_;
my $self = bless {}, $class;
$self->init($r);
return $self;
@@ -575,7 +575,7 @@
sub shebang_to_perl {
my $self = shift;
- my($line) = ${ $self->{CODE} } =~ /^(.*)$/m;
+ my ($line) = ${ $self->{CODE} } =~ /^(.*)$/m;
my @cmdline = split /\s+/, $line;
return "" unless @cmdline;
return "" unless shift(@cmdline) =~ /^\#!/;
@@ -617,7 +617,7 @@
*chdir_file = \&NOP;
sub chdir_file_normal {
- my($self, $dir) = @_;
+ my ($self, $dir) = @_;
$dir ||= File::Basename::dirname($self->{FILENAME});
$self->debug("chdir $dir") if DEBUG & D_NOISE;
chdir $dir or die "Can't chdir to $dir: $!";
@@ -662,7 +662,7 @@
#########################################################################
sub compile {
- my($self, $eval) = @_;
+ my ($self, $eval) = @_;
$self->debug("compiling $self->{FILENAME}") if DEBUG && D_COMPILE;
@@ -711,10 +711,10 @@
#########################################################################
sub install_aliases {
- my($class, $rh_aliases) = @_;
+ my ($class, $rh_aliases) = @_;
no strict 'refs';
- while (my($k,$v) = each %$rh_aliases) {
+ while (my ($k,$v) = each %$rh_aliases) {
if (my $sub = *{$v}{CODE}){
*{ $class . "::$k" } = $sub;
}
@@ -733,7 +733,7 @@
}
sub log_error {
- my($self, $msg) = @_;
+ my ($self, $msg) = @_;
my $class = ref $self;
$self->{REQ}->log_error($msg);
@@ -763,7 +763,7 @@
# cache_table() to point to another function, this function will fail.
sub uncache_myself {
my $package = scalar caller;
- my($class) = __PACKAGE__->cache_table_common();
+ my ($class) = __PACKAGE__->cache_table_common();
unless (defined $class) {
Apache2->warn("$$: cannot figure out cache symbol table for $package");
diff --git a/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm b/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
index d017ee6..3af2915 100644
--- a/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
+++ b/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
@@ -19,6 +19,7 @@
use ModPerl::RegistryCooker ();
use Apache2::ServerUtil ();
+use Apache2::Log ();
use APR::Pool ();
use Carp;
@@ -38,7 +39,7 @@
}
sub handler {
- my($self, $uri, $filename, $virthost) = @_;
+ my ($self, $uri, $filename, $virthost) = @_;
# set the inheritance rules at run time
@ISA = $self->{package};
@@ -142,7 +143,7 @@
}
sub load_package {
- my($self, $package) = @_;
+ my ($self, $package) = @_;
croak "package to load wasn't specified" unless defined $package;
@@ -153,7 +154,7 @@
sub warn {
my $self = shift;
- Apache2->warn(__PACKAGE__ . ": @_\n");
+ Apache2::Log->warn(__PACKAGE__ . ": @_\n");
}
1;
diff --git a/ModPerl-Registry/t/206.t b/ModPerl-Registry/t/206.t
index ebd52f0..65ce1f5 100644
--- a/ModPerl-Registry/t/206.t
+++ b/ModPerl-Registry/t/206.t
@@ -5,7 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET);
-plan tests => 2, need 'mod_alias.c';
+plan tests => 2, need [qw(mod_alias.c HTML::HeadParser)];
my $url = "/registry/206.pl";
my $res = GET($url);
diff --git a/ModPerl-Registry/t/304.t b/ModPerl-Registry/t/304.t
index eabb0fa..c53d5e3 100644
--- a/ModPerl-Registry/t/304.t
+++ b/ModPerl-Registry/t/304.t
@@ -5,7 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET);
-plan tests => 10, need 'mod_alias.c';
+plan tests => 10, need [qw(mod_alias.c HTML::HeadParser)];
my $url = "/registry/304.pl";
@@ -42,7 +42,7 @@
'Thu Juk 99 00:00:00 9999 FUK' => "bogus If-Modified-Since #2",
);
my $received = '<html><head></head><body>Test</body></html>';
- while ( my($if_modified_since, $debug) = each %dates) {
+ while ( my ($if_modified_since, $debug) = each %dates) {
my $res = GET($url, 'If-Modified-Since' => $if_modified_since);
t_debug "If-Modified-Since $if_modified_since";
ok t_cmp(
diff --git a/ModPerl-Registry/t/404.t b/ModPerl-Registry/t/404.t
index 294b375..d603048 100644
--- a/ModPerl-Registry/t/404.t
+++ b/ModPerl-Registry/t/404.t
@@ -5,7 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY GET);
-plan tests => 2, need 'mod_alias.c';
+plan tests => 2, need [qw(mod_alias.c HTML::HeadParser)];
{
t_client_log_error_is_expected();
diff --git a/ModPerl-Registry/t/cgi.t b/ModPerl-Registry/t/cgi.t
index c1f4ca6..771f241 100644
--- a/ModPerl-Registry/t/cgi.t
+++ b/ModPerl-Registry/t/cgi.t
@@ -5,7 +5,8 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET);
-plan tests => 2, need 'mod_alias.c', need_min_module_version CGI => 3.08;
+plan tests => 2, need [qw(mod_alias.c HTML::HeadParser)],
+ need_min_module_version CGI => 3.08;
my $url = "/registry/cgi.pl";
my $res = GET $url;
diff --git a/ModPerl-Registry/t/closure.t b/ModPerl-Registry/t/closure.t
index 3106c8d..842ef11 100644
--- a/ModPerl-Registry/t/closure.t
+++ b/ModPerl-Registry/t/closure.t
@@ -17,7 +17,7 @@
my @modules = qw(registry registry_bb perlrun);
-plan tests => 6, need 'mod_alias.c';
+plan tests => 6, need [qw(mod_alias.c HTML::HeadParser)];
my $cfg = Apache::Test::config();
diff --git a/ModPerl-Registry/t/flush.t b/ModPerl-Registry/t/flush.t
index cc4bb89..b095815 100644
--- a/ModPerl-Registry/t/flush.t
+++ b/ModPerl-Registry/t/flush.t
@@ -5,7 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY);
-plan tests => 1, need 'deflate', 'mod_alias.c',
+plan tests => 1, need [qw(mod_alias.c deflate HTML::HeadParser)],
need_min_module_version("Compress::Zlib", "1.09"),
need_min_apache_version("2.0.48");
# it requires httpd 2.0.48 because of the bug in mod_deflate:
diff --git a/ModPerl-Registry/t/perlrun_extload.t b/ModPerl-Registry/t/perlrun_extload.t
index 8d11321..357e44c 100644
--- a/ModPerl-Registry/t/perlrun_extload.t
+++ b/ModPerl-Registry/t/perlrun_extload.t
@@ -6,7 +6,7 @@
use Apache::TestRequest qw(GET);
use TestCommon::SameInterp;
-plan tests => 2, need 'mod_alias.c';
+plan tests => 2, need [qw(mod_alias.c HTML::HeadParser)];
my $url = "/same_interp/perlrun/perlrun_extload.pl";
my $same_interp = Apache::TestRequest::same_interp_tie($url);
diff --git a/ModPerl-Registry/t/redirect.t b/ModPerl-Registry/t/redirect.t
index 50c7bc5..303fc8c 100644
--- a/ModPerl-Registry/t/redirect.t
+++ b/ModPerl-Registry/t/redirect.t
@@ -7,7 +7,7 @@
use Apache::TestUtil qw(t_catfile_apache);
-plan tests => 4, need 'mod_alias.c', need_lwp;
+plan tests => 4, need [qw(mod_alias.c HTML::HeadParser)], need_lwp;
# need LWP to handle redirects
my $base_url = "/registry/redirect.pl";
diff --git a/ModPerl-Registry/t/special_blocks.t b/ModPerl-Registry/t/special_blocks.t
index 0c5a356..d795425 100644
--- a/ModPerl-Registry/t/special_blocks.t
+++ b/ModPerl-Registry/t/special_blocks.t
@@ -16,7 +16,7 @@
my @aliases = sort keys %modules;
-plan tests => @aliases * 4, need 'mod_alias.c';
+plan tests => @aliases * 4, need [qw(mod_alias.c HTML::HeadParser)];
{
# PerlRun always run BEGIN/END since it's never cached
diff --git a/lib/Apache2/Build.pm b/lib/Apache2/Build.pm
index 35e1799..4122048 100644
--- a/lib/Apache2/Build.pm
+++ b/lib/Apache2/Build.pm
@@ -154,7 +154,7 @@
return $path unless $self->{MP_AP_DESTDIR};
if (WIN32) {
- my($dest_vol, $dest_dir) = splitpath $self->{MP_AP_DESTDIR}, 1;
+ my ($dest_vol, $dest_dir) = splitpath $self->{MP_AP_DESTDIR}, 1;
my $real_dir = (splitpath $path)[1];
$path = catpath $dest_vol, catdir($dest_dir, $real_dir), '';
@@ -308,11 +308,30 @@
$self->{'httpd'} ||= $httpd;
push @Apache::TestMM::Argv, ('httpd' => $self->{'httpd'});
- my $mplib = "$self->{MP_LIBNAME}$Config{lib_ext}";
- my $mplibpath = catfile($self->{cwd}, qw(src modules perl), $mplib);
+ my $mplibpath = '';
+ my $ldopts = $self->ldopts;
+
+ if (CYGWIN) {
+ # Cygwin's httpd port links its modules into httpd2core.dll, instead of httpd.exe.
+ # In this case, we have a problem, because libtool doesn't want to include
+ # static libs (.a) into a dynamic lib (.dll). Workaround this by setting
+ # mod_perl.a as a linker argument (including all other flags and libs).
+ my $mplib = "$self->{MP_LIBNAME}$Config{lib_ext}";
+
+ $ldopts = join ' ',
+ '--export-all-symbols',
+ "$self->{cwd}/src/modules/perl/$mplib",
+ $ldopts;
+
+ $ldopts =~ s/(\S+)/-Wl,$1/g;
+
+ } else {
+ my $mplib = "$self->{MP_LIBNAME}$Config{lib_ext}";
+ $mplibpath = catfile($self->{cwd}, qw(src modules perl), $mplib);
+ }
local $ENV{BUILTIN_LIBS} = $mplibpath;
- local $ENV{AP_LIBS} = $self->ldopts;
+ local $ENV{AP_LIBS} = $ldopts;
local $ENV{MODLIST} = 'perl';
#XXX: -Wall and/or -Werror at httpd configure time breaks things
@@ -415,7 +434,7 @@
my $self = shift;
my $xlibs = "";
- my($path) = $self->find_dlfile('Xau', @Xlib);
+ my ($path) = $self->find_dlfile('Xau', @Xlib);
if ($path) {
$xlibs = "-L$path -lXau";
}
@@ -436,7 +455,7 @@
}
sub ldopts {
- my($self) = @_;
+ my ($self) = @_;
my $config = tied %Config;
my $ldflags = $config->{ldflags};
@@ -469,10 +488,6 @@
$ldopts .= $self->gtop_ldopts;
}
- if (CYGWIN && $self->is_dynamic) {
- $ldopts .= join ' ', '', $self->apru_link_flags;
- }
-
$config->{ldflags} = $ldflags; #reset
# on Irix mod_perl.so needs to see the libperl.so symbols, which
@@ -493,7 +508,7 @@
$Wall .= " -Werror" if $] >= 5.006002;
sub ap_ccopts {
- my($self) = @_;
+ my ($self) = @_;
my $ccopts = "-DMOD_PERL";
if ($self->{MP_USE_GTOP}) {
@@ -508,6 +523,12 @@
$ccopts .= " $Wall -DAP_DEBUG";
$ccopts .= " -DAP_HAVE_DESIGNATED_INITIALIZER";
}
+
+ if ($self->has_gcc_version('3.3.2') &&
+ $ccopts !~ /declaration-after-statement/) {
+ debug "Adding -Wdeclaration-after-statement to ccopts";
+ $ccopts .= " -Wdeclaration-after-statement";
+ }
}
if ($self->{MP_COMPAT_1X}) {
@@ -540,6 +561,31 @@
$ccopts;
}
+sub has_gcc_version {
+ my $self = shift;
+ my $requested_version = shift;
+
+ my $has_version = $self->perl_config('gccversion');
+
+ return 0 unless $has_version;
+
+ my @tuples = split /\./, $has_version, 3;
+ my @r_tuples = split /\./, $requested_version, 3;
+
+ return cmp_tuples(\@tuples, \@r_tuples) == 1;
+}
+
+sub cmp_tuples {
+ my ($num_a, $num_b) = @_;
+
+ while (@$num_a && @$num_b) {
+ my $cmp = shift @$num_a <=> shift @$num_b;
+ return $cmp if $cmp;
+ }
+
+ return @$num_a <=> @$num_b;
+}
+
sub perl_ccopts {
my $self = shift;
@@ -576,7 +622,7 @@
# XXX: there could be more, but this is just for cosmetics
my %cflags_dups = map { $_ => 1 } qw(-D_GNU_SOURCE -D_REENTRANT);
sub ccopts {
- my($self) = @_;
+ my ($self) = @_;
my $cflags = $self->perl_ccopts . ExtUtils::Embed::perl_inc() .
$self->ap_ccopts;
@@ -602,7 +648,7 @@
}
sub perl_config_optimize {
- my($self, $val) = @_;
+ my ($self, $val) = @_;
$val ||= $Config{optimize};
@@ -614,7 +660,7 @@
}
sub perl_config_ld {
- my($self, $val) = @_;
+ my ($self, $val) = @_;
$val ||= $Config{ld};
@@ -622,7 +668,7 @@
}
sub perl_config_lddlflags {
- my($self, $val) = @_;
+ my ($self, $val) = @_;
if ($self->{MP_DEBUG}) {
if (MSVC) {
@@ -663,7 +709,7 @@
}
sub perl_config {
- my($self, $key) = @_;
+ my ($self, $key) = @_;
my $val = $Config{$key} || '';
@@ -692,14 +738,14 @@
}
sub find_dlfile {
- my($self, $name) = (shift, shift);
+ my ($self, $name) = (shift, shift);
require DynaLoader;
require AutoLoader; #eek
my $found = 0;
my $loc = "";
- my(@path) = ($self->libpth, @_);
+ my (@path) = ($self->libpth, @_);
for (@path) {
if ($found = DynaLoader::dl_findfile($_, "-l$name")) {
@@ -712,7 +758,7 @@
}
sub find_dlfile_maybe {
- my($self, $name) = @_;
+ my ($self, $name) = @_;
my $path = $self->libpth;
@@ -727,7 +773,7 @@
}
sub lib_check {
- my($self, $name) = @_;
+ my ($self, $name) = @_;
return unless $self->perl_config('libs') =~ /$name/;
return if $self->find_dlfile($name);
@@ -746,24 +792,24 @@
#--- user interaction ---
sub prompt {
- my($self, $q, $default) = @_;
+ my ($self, $q, $default) = @_;
return $default if $self->{MP_PROMPT_DEFAULT};
require ExtUtils::MakeMaker;
ExtUtils::MakeMaker::prompt($q, $default);
}
sub prompt_y {
- my($self, $q) = @_;
+ my ($self, $q) = @_;
$self->prompt($q, 'y') =~ /^y/i;
}
sub prompt_n {
- my($self, $q) = @_;
+ my ($self, $q) = @_;
$self->prompt($q, 'n') =~ /^n/i;
}
sub phat_warn {
- my($self, $msg, $abort) = @_;
+ my ($self, $msg, $abort) = @_;
my $level = $abort ? 'ERROR' : 'WARNING';
warn <<EOF;
************* $level *************
@@ -802,7 +848,7 @@
}
return bless {}, (ref($self) || $self) if $@;
- return Apache2::BuildConfig::->new;
+ return Apache2::BuildConfig->new;
}
sub new {
@@ -835,7 +881,7 @@
}
sub default_file {
- my($self, $name, $override) = @_;
+ my ($self, $name, $override) = @_;
my $key = join '_', 'file', $name;
$self->{$key} ||= ($override || $default_files{$name});
}
@@ -856,7 +902,7 @@
}
sub save_ldopts {
- my($self, $file) = @_;
+ my ($self, $file) = @_;
$file ||= $self->default_file('ldopts', $file);
my $ldopts = $self->ldopts;
@@ -872,7 +918,7 @@
}
sub save {
- my($self, $file) = @_;
+ my ($self, $file) = @_;
delete $INC{$bpm};
@@ -926,7 +972,7 @@
}
sub dir {
- my($self, $dir) = @_;
+ my ($self, $dir) = @_;
if ($dir) {
for (qw(ap_includedir)) {
@@ -988,7 +1034,7 @@
}
sub ap_includedir {
- my($self, $d) = @_;
+ my ($self, $d) = @_;
return $self->{ap_includedir}
if $self->{ap_includedir} and -d $self->{ap_includedir};
@@ -1048,15 +1094,15 @@
}
sub apr_generation {
- my($self) = @_;
- return $self->httpd_version_as_int =~ m/21\d+/ ? 1 : 0;
+ my ($self) = @_;
+ return $self->httpd_version_as_int =~ m/2[1-9]\d+/ ? 1 : 0;
}
# returns an array of apr/apu linking flags (--link-ld --libs) if found
# an empty array otherwise
my @apru_link_flags = ();
sub apru_link_flags {
- my($self) = @_;
+ my ($self) = @_;
return @apru_link_flags if @apru_link_flags;
@@ -1122,7 +1168,7 @@
if ($self->{MP_AP_CONFIGURE} &&
$self->{MP_AP_CONFIGURE} =~ /--with-${what_long}=(\S+)/) {
my $dir = $1;
- $dir =~ s/$config$// unless -d $dir;
+ $dir = dirname $dir if -f $dir;
push @tries, grep -d $_, $dir, catdir $dir, 'bin';
}
}
@@ -1206,7 +1252,7 @@
#--- parsing apache *.h files ---
sub mmn_eq {
- my($class, $dir) = @_;
+ my ($class, $dir) = @_;
return 1 if WIN32; #just assume, till Apache2::Build works under win32
@@ -1272,20 +1318,20 @@
}
sub httpd_version_as_int {
- my($self, $dir) = @_;
+ my ($self, $dir) = @_;
my $v = $self->httpd_version($dir);
fold_dots($v);
}
sub httpd_version_cache {
- my($self, $dir, $v) = @_;
+ my ($self, $dir, $v) = @_;
return '' unless $dir;
$self->{httpd_version}->{$dir} = $v if $v;
$self->{httpd_version}->{$dir};
}
sub httpd_version {
- my($self, $dir) = @_;
+ my ($self, $dir) = @_;
return unless $dir = $self->ap_includedir($dir);
@@ -1357,7 +1403,7 @@
while (<$fh>) {
next unless s/^\#define\s+APR_((HAVE|HAS|USE)_\w+)/$1/;
chomp;
- my($name, $val) = split /\s+/, $_, 2;
+ my ($name, $val) = split /\s+/, $_, 2;
next unless $wanted_apr_config{$name};
$val =~ s/\s+$//;
next unless $val =~ /^\d+$/;
@@ -1370,7 +1416,7 @@
#--- generate Makefile ---
sub canon_make_attr {
- my($self, $name) = (shift, shift);
+ my ($self, $name) = (shift, shift);
my $attr = join '_', 'MODPERL', uc $name;
$self->{$attr} = "@_";
@@ -1393,7 +1439,7 @@
}
sub make_xs {
- my($self, $fh) = @_;
+ my ($self, $fh) = @_;
print $fh $self->canon_make_attr(xsubpp => $self->xsubpp);
@@ -1402,7 +1448,7 @@
my @files;
my @xs_targ;
- while (my($name, $xs) = each %{ $self->{XS} }) {
+ while (my ($name, $xs) = each %{ $self->{XS} }) {
#Foo/Bar.xs => Foo_Bar.c
(my $c = $xs) =~ s:.*?WrapXS/::;
$c =~ s:/:_:g;
@@ -1458,7 +1504,7 @@
my @mm_init_vars = (BASEEXT => '');
sub make_tools {
- my($self, $fh) = @_;
+ my ($self, $fh) = @_;
for (@perl_config_pm) {
print $fh $self->canon_make_attr($_, $self->perl_config($_));
@@ -1537,6 +1583,21 @@
"\t" . '$(MODPERL_RANLIB) $@';
}
+sub dynamic_link_cygwin {
+ my $self = shift;
+ return <<'EOF';
+$(MODPERL_LIBNAME).$(MODPERL_DLEXT): $(MODPERL_PIC_OBJS)
+ $(MODPERL_RM_F) $@
+ $(MODPERL_CC) -shared -o $@ \
+ -Wl,--out-implib=$(MODPERL_LIBNAME).dll.a \
+ -Wl,--export-all-symbols -Wl,--enable-auto-import -Wl,--stack,8388608 \
+ $(MODPERL_PIC_OBJS) \
+ $(MODPERL_LDDLFLAGS) $(MODPERL_LDOPTS) \
+ $(MODPERL_AP_LIBS)
+ $(MODPERL_RANLIB) $@
+EOF
+}
+
sub dynamic_link {
my $self = shift;
my $link = \&{"dynamic_link_$^O"};
@@ -1544,6 +1605,34 @@
$link->($self);
}
+# Returns the link flags for the apache shared core library
+my $apache_corelib_cygwin;
+sub apache_corelib_cygwin {
+ return $apache_corelib_cygwin if $apache_corelib_cygwin;
+
+ my $self = shift;
+ my $mp_src = "$self->{cwd}/src/modules/perl";
+ my $core = 'httpd2core';
+
+ # There's a problem with user-installed perl on cygwin.
+ # MakeMaker doesn't know about the .dll.a libs and warns
+ # about missing -lhttpd2core. "Fix" it by copying
+ # the lib and adding .a suffix.
+ # For the static build create a soft link, because libhttpd2core.dll.a
+ # doesn't exist at this time.
+ if ($self->is_dynamic) {
+ my $libpath = $self->apxs(-q => 'exp_libdir');
+ File::Copy::copy("$libpath/lib$core.dll.a", "$mp_src/lib$core.a");
+ } else {
+ my $libpath = catdir($self->{MP_AP_PREFIX}, '.libs');
+ mkdir $libpath unless -d $libpath;
+ qx{touch $libpath/lib$core.dll.a && \
+ ln -fs $libpath/lib$core.dll.a $mp_src/lib$core.a};
+ }
+
+ $apache_corelib_cygwin = "-L$mp_src -l$core";
+}
+
sub apache_libs_MSWin32 {
my $self = shift;
my $prefix = $self->apxs(-q => 'PREFIX') || $self->dir;
@@ -1551,6 +1640,11 @@
"@libs";
}
+sub apache_libs_cygwin {
+ my $self = shift;
+ join ' ', $self->apache_corelib_cygwin, $self->apru_link_flags;
+}
+
sub apache_libs {
my $self = shift;
my $libs = \&{"apache_libs_$^O"};
@@ -1560,16 +1654,13 @@
sub modperl_libs_MSWin32 {
my $self = shift;
- # mod_perl.lib will be installed into MP_AP_PREFIX/lib
- # for use by 3rd party xs modules
"$self->{cwd}/src/modules/perl/$self->{MP_LIBNAME}.lib";
}
sub modperl_libs_cygwin {
my $self = shift;
- return $self->is_dynamic
- ? "-L$self->{cwd}/src/modules/perl -l$self->{MP_LIBNAME}"
- : $self->modperl_static_libs_cygwin;
+ return '' unless $self->is_dynamic;
+ return "-L$self->{cwd}/src/modules/perl -l$self->{MP_LIBNAME}";
}
sub modperl_libs {
@@ -1579,35 +1670,23 @@
$libs->($self);
}
-my $modperl_static_libs_cygwin = '';
-sub modperl_static_libs_cygwin {
+sub modperl_libpath_MSWin32 {
my $self = shift;
+ # mod_perl.lib will be installed into MP_AP_PREFIX/lib
+ # for use by 3rd party xs modules
+ "$self->{cwd}/src/modules/perl/$self->{MP_LIBNAME}.lib";
+}
- return $modperl_static_libs_cygwin if $modperl_static_libs_cygwin;
+sub modperl_libpath_cygwin {
+ my $self = shift;
+ "$self->{cwd}/src/modules/perl/$self->{MP_LIBNAME}.dll.a";
+}
- my $dyna_filepath = catdir $self->perl_config('archlibexp'),
- 'auto/DynaLoader/DynaLoader.a';
- my $modperl_path = "$self->{cwd}/src/modules/perl";
- # Create symlink to mod_perl.a, but copy DynaLoader.a, because
- # when running make clean the real DynaLoader.a may get deleted.
- my $src = catfile $modperl_path, "$self->{MP_LIBNAME}.a";
- my $dst = catfile $modperl_path, "lib$self->{MP_LIBNAME}.a";
- # perl's link() on Cygwin seems to copy mod_perl.a to
- # libmod_perl.a, but at this stage mod_perl.a is still a dummy lib
- # and at the end we get nothing. whereas `ln -s` seems to create
- # something like the shortcut on windows and it works.
- qx{ln -s $src $dst} unless -e $dst;
- File::Copy::copy($dyna_filepath, "$modperl_path/libDynaLoader.a");
-
- $modperl_static_libs_cygwin = join ' ',
- "-L$modperl_path",
- "-l$self->{MP_LIBNAME}",
- '-lDynaLoader',
- $self->apru_link_flags,
- '-L' . catdir($self->perl_config('archlibexp'), 'CORE'),
- '-lperl';
-
- $modperl_static_libs_cygwin;
+sub modperl_libpath {
+ my $self = shift;
+ my $libpath = \&{"modperl_libpath_$^O"};
+ return "" unless defined &$libpath;
+ $libpath->($self);
}
# returns the directory and name of the aprext lib built under blib/
@@ -1639,7 +1718,7 @@
# This is ugly, but is the only way to prevent the "undefined
# symbols" error
- $libs .= join ' ', '', $self->apru_link_flags,
+ $libs .= join ' ', '',
'-L' . catdir($self->perl_config('archlibexp'), 'CORE'), '-lperl';
$libs;
@@ -1682,7 +1761,7 @@
$(MODPERL_CP) $(MODPERL_LIB_DSO) $(DESTDIR)$(MODPERL_AP_LIBEXECDIR)
EOI
}
-
+
$install .= <<'EOI';
# install mod_perl .h files
@$(MKPATH) $(DESTDIR)$(MODPERL_AP_INCLUDEDIR)
@@ -1717,7 +1796,7 @@
#XXX short-term compat for Apache::TestConfigPerl
$libs{shared} = $libs{dso};
- while (my($type, $lib) = each %libs) {
+ while (my ($type, $lib) = each %libs) {
print $fh $self->canon_make_attr("lib_$type", $libs{$type});
}
@@ -1731,7 +1810,7 @@
EOI
}
- if (my $libs = $self->modperl_libs) {
+ if ($self->is_dynamic && (my $libs = $self->modperl_libpath)) {
print $fh $self->canon_make_attr('lib_location', $libs);
print $fh $self->canon_make_attr('ap_libdir',
@@ -1880,17 +1959,6 @@
$flags;
}
-sub otherldflags_cygwin {
- my $self = shift;
- my $flags = $self->otherldflags_default;
-
- unless ($self->{MP_STATIC_EXTS}) {
- $flags .= join ' ', '', $self->apru_link_flags;
- }
-
- $flags;
-}
-
sub typemaps {
my $self = shift;
my @typemaps = ();
@@ -2049,7 +2117,7 @@
# will have to make sure to prevent any operations that may rely on
# effects created by uselargefiles, e.g. Off_t=8 instead of Off_t=4)
sub strip_lfs {
- my($self, $cflags) = @_;
+ my ($self, $cflags) = @_;
return $cflags unless $self->has_large_files_conflict();
my $lf = $Config{ccflags_uselargefiles}
diff --git a/lib/Apache2/ParseSource.pm b/lib/Apache2/ParseSource.pm
index 9853ecf..fc20846 100644
--- a/lib/Apache2/ParseSource.pm
+++ b/lib/Apache2/ParseSource.pm
@@ -185,7 +185,7 @@
}
sub find_includes_wanted {
- my($wanted, $unwanted, @dirs) = @_;
+ my ($wanted, $unwanted, @dirs) = @_;
my @includes = ();
for my $dir (@dirs) {
File::Find::finddepth({
@@ -265,8 +265,8 @@
);
my %defines_wanted_re;
-while (my($class, $groups) = each %defines_wanted) {
- while (my($group, $wanted) = each %$groups) {
+while (my ($class, $groups) = each %defines_wanted) {
+ while (my ($group, $wanted) = each %$groups) {
my $pat = join '|', @$wanted;
$defines_wanted_re{$class}->{$group} = $pat; #qr{^($pat)};
}
@@ -282,10 +282,10 @@
};
sub get_constants {
- my($self) = @_;
+ my ($self) = @_;
my $includes = $self->find_includes;
- my(%constants, %seen);
+ my (%constants, %seen);
for my $file (@$includes) {
open my $fh, $file or die "open $file: $!";
@@ -312,15 +312,15 @@
}
sub handle_constant {
- my($self, $constants) = @_;
+ my ($self, $constants) = @_;
my $keys = keys %defines_wanted_re; #XXX broken bleedperl ?
return if /^($defines_unwanted)/o;
- while (my($class, $groups) = each %defines_wanted_re) {
+ while (my ($class, $groups) = each %defines_wanted_re) {
my $keys = keys %$groups; #XXX broken bleedperl ?
- while (my($group, $re) = each %$groups) {
+ while (my ($group, $re) = each %$groups) {
next unless /^($re)/;
push @{ $constants->{$class}->{$group} }, $_;
return;
@@ -329,9 +329,9 @@
}
sub handle_enum {
- my($self, $fh, $constants) = @_;
+ my ($self, $fh, $constants) = @_;
- my($name, $e) = $self->parse_enum($fh);
+ my ($name, $e) = $self->parse_enum($fh);
return unless $name;
$name =~ s/^ap_//;
@@ -351,7 +351,7 @@
#this should win an award for worlds lamest parser
sub parse_enum {
- my($self, $fh) = @_;
+ my ($self, $fh) = @_;
my $code = $_;
my @e;
@@ -404,7 +404,7 @@
my @functions;
for my $entry (@$fdecls) {
- my($rtype, $name, $args) = @$entry;
+ my ($rtype, $name, $args) = @$entry;
next unless $name =~ $wanted;
next if $seen{$name}++;
my @attr;
@@ -461,7 +461,7 @@
my @structures;
my $sx = qr(^struct\s+);
- while (my($type, $elts) = each %$typedef_structs) {
+ while (my ($type, $elts) = each %$typedef_structs) {
next unless $type =~ $wanted or $type =~ /($other)$/o;
$type =~ s/$sx//;
@@ -512,12 +512,12 @@
}
sub write_pm {
- my($self, $file, $name, $data) = @_;
+ my ($self, $file, $name, $data) = @_;
require Data::Dumper;
local $Data::Dumper::Indent = 1;
- my($subdir) = (split '::', $name)[0];
+ my ($subdir) = (split '::', $name)[0];
my $tdir = 'xs/tables/current';
if (-d "$tdir/$subdir") {
diff --git a/lib/Apache2/PerlSections.pm b/lib/Apache2/PerlSections.pm
index 85f73c3..68e5b4a 100644
--- a/lib/Apache2/PerlSections.pm
+++ b/lib/Apache2/PerlSections.pm
@@ -30,7 +30,7 @@
use constant SPECIAL_PACKAGE => 'Apache2::ReadConfig';
sub new {
- my($package, @args) = @_;
+ my ($package, @args) = @_;
return bless { @args }, ref($package) || $package;
}
@@ -43,7 +43,7 @@
sub saved { return @saved }
sub handler : method {
- my($self, $parms, $args) = @_;
+ my ($self, $parms, $args) = @_;
unless (ref $self) {
$self = $self->new('parms' => $parms, 'args' => $args);
@@ -75,7 +75,7 @@
}
sub symdump {
- my($self) = @_;
+ my ($self) = @_;
unless ($self->{symbols}) {
no strict;
@@ -107,12 +107,12 @@
}
sub dump_special {
- my($self, @data) = @_;
+ my ($self, @data) = @_;
$self->add_config(@data);
}
sub dump_any {
- my($self, $name, $entry) = @_;
+ my ($self, $name, $entry) = @_;
my $type = ref $entry;
if ($type eq 'ARRAY') {
@@ -127,7 +127,7 @@
}
sub dump_hash {
- my($self, $name, $hash) = @_;
+ my ($self, $name, $hash) = @_;
for my $entry (sort keys %{ $hash || {} }) {
my $item = $hash->{$entry};
@@ -145,7 +145,7 @@
}
sub dump_section {
- my($self, $name, $loc, $hash) = @_;
+ my ($self, $name, $loc, $hash) = @_;
$self->add_config("<$name $loc>\n");
@@ -157,7 +157,7 @@
}
sub dump_array {
- my($self, $name, $entries) = @_;
+ my ($self, $name, $entries) = @_;
for my $entry (@$entries) {
$self->dump_entry($name, $entry);
@@ -165,7 +165,7 @@
}
sub dump_entry {
- my($self, $name, $entry) = @_;
+ my ($self, $name, $entry) = @_;
my $type = ref $entry;
if ($type eq 'SCALAR') {
@@ -192,14 +192,14 @@
}
sub add_config {
- my($self, $config) = @_;
+ my ($self, $config) = @_;
return unless defined $config;
chomp($config);
push @{ $self->directives }, $config;
}
sub post_config {
- my($self) = @_;
+ my ($self) = @_;
my $errmsg = $self->parms->add_config($self->directives);
die $errmsg if $errmsg;
}
diff --git a/lib/Apache2/PerlSections/Dump.pm b/lib/Apache2/PerlSections/Dump.pm
index 83b93ef..a7cd8d6 100644
--- a/lib/Apache2/PerlSections/Dump.pm
+++ b/lib/Apache2/PerlSections/Dump.pm
@@ -54,12 +54,12 @@
}
sub dump_array {
- my($self, $name, $entry) = @_;
+ my ($self, $name, $entry) = @_;
$self->add_config(Data::Dumper->Dump([$entry], ["*$name"]));
}
sub dump_hash {
- my($self, $name, $entry) = @_;
+ my ($self, $name, $entry) = @_;
for my $elem (sort keys %{$entry}) {
$self->add_config(Data::Dumper->Dump([$entry->{$elem}], ["\$$name"."{'$elem'}"]));
}
@@ -67,7 +67,7 @@
}
sub dump_entry {
- my($self, $name, $entry) = @_;
+ my ($self, $name, $entry) = @_;
return if not defined $entry;
my $type = ref($entry);
@@ -84,7 +84,7 @@
}
sub dump_special {
- my($self, @data) = @_;
+ my ($self, @data) = @_;
my @dump = grep { defined } @data;
return unless @dump;
diff --git a/lib/Apache2/Reload.pm b/lib/Apache2/Reload.pm
index bb10b98..c5254b1 100644
--- a/lib/Apache2/Reload.pm
+++ b/lib/Apache2/Reload.pm
@@ -37,7 +37,7 @@
sub import {
my $class = shift;
- my($package, $file) = (caller)[0,1];
+ my ($package, $file) = (caller)[0,1];
$class->register_module($package, $file);
}
@@ -57,7 +57,7 @@
}
sub register_module {
- my($class, $package, $file) = @_;
+ my ($class, $package, $file) = @_;
my $module = package_to_module($package);
if ($file) {
@@ -71,7 +71,7 @@
}
sub unregister_module {
- my($class, $package) = @_;
+ my ($class, $package) = @_;
my $module = package_to_module($package);
delete $INCS{$module};
}
@@ -131,7 +131,9 @@
my $ReloadDirs = ref($o) && $o->dir_config("ReloadDirectories");
my @watch_dirs = split(/\s+/, $ReloadDirs||'');
- while (my($key, $file) = each %Apache2::Reload::INCS) {
+ foreach my $key (sort { $a cmp $b } keys %Apache2::Reload::INCS) {
+ my $file = $Apache2::Reload::INCS{$key};
+
next unless defined $file;
next if @watch_dirs && !grep { $file =~ /^$_/ } @watch_dirs;
warn "Apache2::Reload: Checking mtime of $key\n" if $DEBUG;
diff --git a/lib/Apache2/Resource.pm b/lib/Apache2/Resource.pm
index 8ff06ad..7b1bb33 100644
--- a/lib/Apache2/Resource.pm
+++ b/lib/Apache2/Resource.pm
@@ -55,7 +55,7 @@
sub debug { print STDERR @_ if $Debug }
sub install_rlimit ($$$) {
- my($res, $soft, $hard) = @_;
+ my ($res, $soft, $hard) = @_;
my $name = $res;
@@ -82,11 +82,11 @@
}
sub handler {
- while (my($k, $v) = each %ENV) {
+ while (my ($k, $v) = each %ENV) {
next unless $k =~ /^PERL_RLIMIT_(\w+)$/;
$k = $1;
next if $k eq "DEFAULTS";
- my($soft, $hard) = split ":", $v, 2;
+ my ($soft, $hard) = split ":", $v, 2;
$hard ||= $soft;
my $set = install_rlimit $k, $soft, $hard;
@@ -99,7 +99,7 @@
}
sub default_handler {
- while (my($k, $v) = each %Apache2::Resource::) {
+ while (my ($k, $v) = each %Apache2::Resource::) {
next unless $k =~ s/^DEFAULT_/PERL_/;
$ENV{$k} = "";
}
@@ -114,7 +114,7 @@
for my $res (keys %$lim) {
my $val = eval "&BSD::Resource::${res}()";
- my($soft, $hard) = getrlimit $val;
+ my ($soft, $hard) = getrlimit $val;
(my $limit = $res) =~ s/^RLIMIT_//;
($soft, $hard) = ("$soft " . BM($soft), "$hard ". BM($hard))
if $is_mb{$limit};
diff --git a/lib/Apache2/SizeLimit.pm b/lib/Apache2/SizeLimit.pm
index 45b56ef..07d4c04 100644
--- a/lib/Apache2/SizeLimit.pm
+++ b/lib/Apache2/SizeLimit.pm
@@ -87,7 +87,7 @@
# return process size (in KB)
sub linux_size_check {
- my($size, $resident, $share) = (0, 0, 0);
+ my ($size, $resident, $share) = (0, 0, 0);
my $file = "/proc/self/statm";
if (open my $fh, "<$file") {
@@ -159,7 +159,7 @@
$START_TIME ||= time;
- my($size, $share) = $HOW_BIG_IS_IT->();
+ my ($size, $share) = $HOW_BIG_IS_IT->();
if (($MAX_PROCESS_SIZE && $size > $MAX_PROCESS_SIZE) ||
($MIN_SHARE_SIZE && $share < $MIN_SHARE_SIZE) ||
diff --git a/lib/Apache2/Status.pm b/lib/Apache2/Status.pm
index a0606ba..d81ab77 100644
--- a/lib/Apache2/Status.pm
+++ b/lib/Apache2/Status.pm
@@ -28,7 +28,7 @@
use Apache2::Const -compile => qw(OK);
-$Apache2::Status::VERSION = '3.00'; # mod_perl 2.0
+$Apache2::Status::VERSION = '4.00'; # mod_perl 2.0
use constant IS_WIN32 => ($^O eq "MSWin32");
@@ -42,14 +42,9 @@
env => "Environment",
sig => "Signal Handlers",
myconfig => "Perl Configuration",
- hooks => "Enabled mod_perl Hooks",
);
-# XXX: is $status{hooks} supported with any mp2 version?
-# If not, why not just remove it from the above initialization?
-delete $status{'hooks'} if $mod_perl2::VERSION >= 1.9901;
delete $status{'sig'} if IS_WIN32;
-# XXX: needs porting
if ($Apache2::PerlSections::Save) {
$status{"section_config"} = "Perl Section Configuration";
}
@@ -62,19 +57,19 @@
b => ["", "B", 0, ],
graph => ["StatusGraph", "B::Graph", 0.03, ],
lexinfo => ["StatusLexInfo", "B::LexInfo", 0, ],
- xref => ["", "B::Xref", 0, ],
+ xref => ["StatusXref", "B::Xref", 1.01, ],
terse => ["StatusTerse", "B::Terse", 0, ],
tersesize => ["StatusTerseSize", "B::TerseSize", 0, ],
packagesize => ["StatusPackageSize", "B::TerseSize", 0, ],
- peek => ["StatusPeek", "Apache2::Peek", 0, ], # XXX: version?
+ peek => ["StatusPeek", "Apache::Peek", 1.03, ],
);
sub has {
- my($r, $what) = @_;
+ my ($r, $what) = @_;
return 0 unless exists $requires{$what};
- my($opt, $module, $version) = @{ $requires{$what} };
+ my ($opt, $module, $version) = @{ $requires{$what} };
(my $file = $module) =~ s|::|/|;
$file .= ".pm";
@@ -98,13 +93,13 @@
}
sub status_config {
- my($r, $key) = @_;
+ my ($r, $key) = @_;
return (lc($r->dir_config($key)) eq "on") ||
(lc($r->dir_config('StatusOptionsAll')) eq "on");
}
sub menu_item {
- my($self, $key, $val, $sub) = @_;
+ my ($self, $key, $val, $sub) = @_;
$status{$key} = $val;
no strict;
no warnings 'redefine';
@@ -112,7 +107,7 @@
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my $qs = $r->args || "";
my $sub = "status_$qs";
no strict 'refs';
@@ -133,7 +128,7 @@
my $uri = $r->uri;
$r->print('<p>');
$r->print(
- map { qq[<a href="$uri?$_">$status{$_}</a><br>\n] } keys %status
+ map { qq[<a href="$uri?$_">$status{$_}</a><br />\n] } sort { lc $a cmp lc $b } keys %status
);
$r->print('</p>');
}
@@ -149,34 +144,36 @@
$r->content_type("text/html");
my $v = $^V ? sprintf "v%vd", $^V : $];
$r->print(<<"EOF");
-<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
-<html lang="en">
-<head>
- <title>Apache2::Status</title>
- <style type="text/css">
- body {
- color: #000;
- background-color: #fff;
- }
- p.hdr {
- background-color: #ddd;
- border: 2px outset;
- padding: 3px;
- width: 99%;
- }
- </style>
-</head>
-<body>
-<p class="hdr">
- Embedded Perl version <b>$v</b> for <b>$srv</b> process <b>$$</b>,<br>
- running since $start
-</p>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html lang="en" xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>Apache2::Status $Apache2::Status::VERSION</title>
+ <style type="text/css">
+ body {
+ color: #000;
+ background-color: #fff;
+ }
+ p.hdr {
+ background-color: #ddd;
+ border: 2px outset;
+ padding: 3px;
+ width: 99%;
+ }
+ </style>
+ </head>
+ <body>
+ <p class="hdr">
+ Embedded Perl version <b>$v</b> for <b>$srv</b> process <b>$$</b>,<br />
+ running since $start
+ </p>
EOF
}
sub symdump {
- my($r, $package) = @_;
+ my ($r, $package) = @_;
return install_hint("Devel::Symdump") unless has($r, "symdump");
@@ -187,34 +184,18 @@
}
sub status_symdump {
- my($r) = @_;
+ my ($r) = @_;
[symdump($r, 'main')];
}
sub status_section_config {
- my($r) = @_;
+ my ($r) = @_;
require Apache2::PerlSections;
["<pre>", Apache2::PerlSections->dump, "</pre>"];
}
-sub status_hooks {
- my($r) = @_;
- # XXX: hooks list access doesn't exist yet in 2.0
- require mod_perl;
- require mod_perl_hooks;
- my @retval = qw(<table>);
- my @list = mod_perl::hooks();
- for my $hook (sort @list) {
- my $on_off =
- mod_perl::hook($hook) ? "<b>Enabled</b>" : "<i>Disabled</i>";
- push @retval, "<tr><td>$hook</td><td>$on_off</td></tr>\n";
- }
- push @retval, qw(</table>);
- \@retval;
-}
-
sub status_inc {
- my($r) = @_;
+ my ($r) = @_;
my $uri = $r->uri;
my @retval = (
@@ -243,12 +224,12 @@
);
}
push @retval, "</table>\n";
- push @retval, "<p><b>\@INC</b> = <br>", join "<br>\n", @INC, "";
+ push @retval, "<p><b>\@INC</b> = <br />", join "<br />\n", @INC, "";
\@retval;
}
sub status_script {
- my($r) = @_;
+ my ($r) = @_;
my @retval = (
'<table border="1">',
@@ -267,7 +248,7 @@
my $RegistryCache;
sub registry_cache {
- my($self, $cache) = @_;
+ my ($self, $cache) = @_;
# XXX: generalize
@@ -276,7 +257,7 @@
}
sub get_packages_per_handler {
- my($root, $stash) = @_;
+ my ($root, $stash) = @_;
my %handlers = ();
my @packages = get_packages($stash);
@@ -288,7 +269,7 @@
}
sub get_packages {
- my($stash) = @_;
+ my ($stash) = @_;
no strict 'refs';
my @packages = ();
@@ -300,7 +281,7 @@
}
sub status_rgysubs {
- my($r) = @_;
+ my ($r) = @_;
local $_;
my $uri = $r->uri;
@@ -318,7 +299,7 @@
push @retval, "<h4>$handler:</h4>\n<p>\n";
for (sort @{ $handlers{$handler} }) {
my $full = join '::', $root, $handler, $_;
- push @retval, qq(<a href="$uri?$full">$_</a>\n), "<br>";
+ push @retval, qq(<a href="$uri?$full">$_</a>\n), "<br />";
}
push @retval, "</p>\n";
}
@@ -385,11 +366,11 @@
}
sub status_data_dump {
- my($r) = @_;
+ my ($r) = @_;
return install_hint('Data::Dumper') unless has($r, "dumper");
- my($name, $type) = (split "/", $r->uri)[-2,-1];
+ my ($name, $type) = (split "/", $r->uri)[-2,-1];
no strict 'refs';
my @retval = "<p>\nData Dump of $name $type\n</p>\n<pre>\n";
@@ -409,11 +390,11 @@
}
sub status_cv_dump {
- my($r) = @_;
+ my ($r) = @_;
return [] unless has($r, "b");
no strict 'refs';
- my($name, $type) = (split "/", $r->uri)[-2,-1];
+ my ($name, $type) = (split "/", $r->uri)[-2,-1];
# could be another child, which doesn't have this symbol table?
return unless *$name{CODE};
@@ -434,8 +415,8 @@
push @retval, "Prototype: ", $proto || "none", "\n";
push @retval, "XSUB: ", $obj->XSUB ? "yes" : "no", "\n";
push @retval, peek_link($r, $name, $type);
- #push @retval, xref_link($r, $name);
push @retval, b_graph_link($r, $name);
+ push @retval, xref_link($r, $name);
push @retval, b_lexinfo_link($r, $name);
push @retval, b_terse_link($r, $name);
push @retval, b_terse_size_link($r, $name);
@@ -446,7 +427,7 @@
}
sub b_lexinfo_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "lexinfo");
@@ -461,23 +442,23 @@
return unless has($r, "lexinfo");
no strict 'refs';
- my($name) = (split "/", $r->uri)[-1];
+ my ($name) = (split "/", $r->uri)[-1];
$r->print("Lexical Info for $name\n\n");
my $lexi = B::LexInfo->new;
my $info = $lexi->cvlexinfo($name);
$r->print(${ $lexi->dumper($info) });
}
-my %b_terse_exp = ('slow' => 'syntax', 'exec' => 'execution');
+my %b_terse_exp = ('slow' => 'syntax', 'exec' => 'execution', basic => 'syntax');
sub b_terse_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "terse");
my $script = $r->location;
my @retval;
- for (qw(exec slow)) {
+ for (qw(exec basic)) {
my $exp = "$b_terse_exp{$_} order";
push @retval,
qq(\n<a href="$script/$_/$name?noh_b_terse">Syntax Tree Dump ($exp)</a>\n);
@@ -492,20 +473,21 @@
return unless has($r, "terse");
no strict 'refs';
- my($arg, $name) = (split "/", $r->uri)[-2,-1];
+ my ($arg, $name) = (split "/", $r->uri)[-2,-1];
$r->print("Syntax Tree Dump ($b_terse_exp{$arg}) for $name\n\n");
# XXX: blead perl dumps things to STDERR, though the same version
# works fine with 1.27
# B::Concise couldn't parse XS code before perl patch 24681 (perl 5.9.3)
- eval { B::Terse::compile($arg, $name)->() };
+ # B::Terse is deprecated and just a wrapper around B::Concise now adays
+ eval { B::Concise::compile("-terse", "-$arg", $name)->() };
if ($@) {
- $r->print("B::Terse has failed: $@");
+ $r->print("B::Concise has failed: $@");
}
}
sub b_terse_size_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "tersesize");
@@ -526,7 +508,7 @@
return unless has($r, "tersesize");
$r->print('<pre>');
- my($arg, $name) = (split "/", $r->uri)[-2,-1];
+ my ($arg, $name) = (split "/", $r->uri)[-2,-1];
my $uri = $r->location;
my $link = qq{<a href="$uri/$name/CODE?cv_dump">$name</a>};
$r->print("Syntax Tree Size ($b_terse_exp{$arg} order) for $link\n\n");
@@ -534,7 +516,7 @@
}
sub b_package_size_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "packagesize");
@@ -543,7 +525,7 @@
}
sub noh_b_package_size {
- my($r) = @_;
+ my ($r) = @_;
$r->content_type("text/html");
return unless has($r, "packagesize");
@@ -551,11 +533,13 @@
$r->print('<pre>');
no strict 'refs';
- my($package) = (split "/", $r->uri)[-1];
+ my ($package) = (split "/", $r->uri)[-1];
my $script = $r->location;
$r->print("Memory Usage for package $package\n\n");
- my($subs, $opcount, $opsize) = B::TerseSize::package_size($package);
- $r->print("Totals: $opsize bytes | $opcount OPs\n\n");
+ my ($subs, $opcount, $opsize) = B::TerseSize::package_size($package);
+ my $Kb = sprintf "%.2f", $opsize / 1024;
+ my $Mb = sprintf "%.2f", $Kb / 1000;
+ $r->print("Totals: $opsize bytes, $Kb Kb, $Mb Mb | $opcount OPs\n\n");
my $nlen = 0;
my @keys = map {
@@ -586,7 +570,7 @@
}
sub b_deparse_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "deparse");
@@ -609,7 +593,7 @@
}
sub b_fathom_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "fathom");
@@ -631,7 +615,7 @@
}
sub peek_link {
- my($r, $name, $type) = @_;
+ my ($r, $name, $type) = @_;
return unless has($r, "peek");
@@ -646,14 +630,14 @@
return unless has($r, "peek");
no strict 'refs';
- my($name, $type) = (split "/", $r->uri)[-2,-1];
+ my ($name, $type) = (split "/", $r->uri)[-2,-1];
$type =~ s/^FUNCTION$/CODE/;
$r->print("Peek Dump of $name $type\n\n");
- Apache2::Peek::Dump(*{$name}{$type});
+ Apache::Peek::Dump(*{$name}{$type});
}
sub xref_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "xref");
@@ -680,7 +664,7 @@
}
sub b_graph_link {
- my($r, $name) = @_;
+ my ($r, $name) = @_;
return unless has($r, "graph");
@@ -706,9 +690,15 @@
my $file = "$dir/$thing.$$.gif";
unless (-e $file) {
- tie *STDOUT, "B::Graph", $r, $file;
- B::Graph::compile("-$type", $thing)->();
- (tied *STDOUT)->{graph}->close;
+ my $rv = tie *STDOUT, "B::Graph", $r, $file;
+ unless ($rv) {
+ $r->content_type("text/plain");
+ $r->print("dot not found\n");
+ }
+ else {
+ B::Graph::compile("-$type", $thing)->();
+ (tied *STDOUT)->{graph}->close;
+ }
}
if (-s $file) {
@@ -730,7 +720,7 @@
}
sub B::Graph::TIEHANDLE {
- my($class, $r, $file) = @_;
+ my ($class, $r, $file) = @_;
if ($file =~ /^([^<>|;]+)$/) {
$file = $1;
@@ -744,13 +734,17 @@
require IO::File;
my $pipe = IO::File->new("|$dot -Tgif -o $file");
- $pipe or die "can't open pipe to dot $!";
- $pipe->autoflush(1);
+ $pipe && $pipe->autoflush(1);
- return bless {
- graph => $pipe,
- r => $r,
- }, $class;
+ if ($pipe) {
+ return bless {
+ graph => $pipe,
+ r => $r,
+ }, $class;
+ }
+ else {
+ return;
+ }
}
sub B::Graph::PRINT {
@@ -762,7 +756,7 @@
my %can_dump = map {$_,1} qw(scalars arrays hashes);
sub as_HTML {
- my($self, $package, $r) = @_;
+ my ($self, $package, $r) = @_;
my @m = qw(<table>);
my $uri = $r->uri;
diff --git a/lib/Apache2/compat.pm b/lib/Apache2/compat.pm
index 7f35c82..848a46e 100644
--- a/lib/Apache2/compat.pm
+++ b/lib/Apache2/compat.pm
@@ -85,7 +85,7 @@
require APR::Finfo;
my $orig_sub = *Apache2::RequestRec::filename{CODE};
*Apache2::RequestRec::filename = sub {
- my($r, $newfile) = @_;
+ my ($r, $newfile) = @_;
my $old_filename;
if (defined $newfile) {
$old_filename = $r->$orig_sub($newfile);
@@ -153,7 +153,7 @@
my $c = shift;
if (@_) {
my $addr_in = shift;
- my($port, $addr) = Socket::unpack_sockaddr_in($addr_in);
+ my ($port, $addr) = Socket::unpack_sockaddr_in($addr_in);
$c->$orig_sub->ip_set($addr);
$c->$orig_sub->port_set($port);
}
@@ -195,7 +195,7 @@
require APR::URI;
my $orig_sub = *APR::URI::unparse{CODE};
*APR::URI::unparse = sub {
- my($uri, $flags) = @_;
+ my ($uri, $flags) = @_;
if (defined $uri->hostname && !defined $uri->scheme) {
# we do this only for back compat, the new APR::URI is
@@ -321,7 +321,7 @@
package Apache;
sub unescape_url_info {
- my($class, $string) = @_;
+ my ($class, $string) = @_;
Apache2::URI::unescape_url($string);
$string =~ tr/+/ /;
$string;
@@ -481,8 +481,8 @@
*request = \&Apache2::request;
sub table_get_set {
- my($r, $table) = (shift, shift);
- my($key, $value) = @_;
+ my ($r, $table) = (shift, shift);
+ my ($key, $value) = @_;
if (1 == @_) {
return wantarray()
@@ -539,13 +539,13 @@
*post_connection = \®ister_cleanup;
sub get_remote_host {
- my($r, $type) = @_;
+ my ($r, $type) = @_;
$type = Apache2::Const::REMOTE_NAME unless defined $type;
$r->connection->get_remote_host($type, $r->per_dir_config);
}
sub parse_args {
- my($r, $string) = @_;
+ my ($r, $string) = @_;
return () unless defined $string and $string;
return map {
@@ -599,7 +599,7 @@
}
sub clear_rgy_endav {
- my($r, $script_name) = @_;
+ my ($r, $script_name) = @_;
require ModPerl::Global;
my $package = 'Apache2::ROOT' . $script_name;
ModPerl::Global::special_list_clear(END => $package);
@@ -646,7 +646,7 @@
#2.0 ap_send_fd() also has an additional offset parameter
sub send_fd_length {
- my($r, $fh, $length) = @_;
+ my ($r, $fh, $length) = @_;
my $buff;
my $total_bytes_sent = 0;
@@ -671,7 +671,7 @@
}
sub send_fd {
- my($r, $fh) = @_;
+ my ($r, $fh) = @_;
$r->send_fd_length($fh, -1);
}
@@ -687,7 +687,7 @@
use Carp ();
sub new {
- my($class) = shift;
+ my ($class) = shift;
my $fh = Symbol::gensym;
my $self = bless $fh, ref($class)||$class;
if (@_) {
@@ -699,7 +699,7 @@
}
sub open {
- my($self) = shift;
+ my ($self) = shift;
Carp::croak("no Apache2::File object passed")
unless $self && ref($self);
@@ -716,7 +716,7 @@
}
sub close {
- my($self) = shift;
+ my ($self) = shift;
CORE::close $self;
}
@@ -761,7 +761,7 @@
package Apache::Util;
sub size_string {
- my($size) = @_;
+ my ($size) = @_;
if (!$size) {
$size = " 0k";
@@ -818,7 +818,7 @@
*validate_password = \&APR::Util::password_validate;
sub Apache2::URI::parse {
- my($class, $r, $uri) = @_;
+ my ($class, $r, $uri) = @_;
$uri ||= $r->construct_url;
@@ -828,7 +828,7 @@
package Apache::Table;
sub new {
- my($class, $r, $nelts) = @_;
+ my ($class, $r, $nelts) = @_;
$nelts ||= 10;
APR::Table::make($r->pool, $nelts);
}
diff --git a/lib/Apache2/porting.pm b/lib/Apache2/porting.pm
index 8fca76e..77821a2 100644
--- a/lib/Apache2/porting.pm
+++ b/lib/Apache2/porting.pm
@@ -38,7 +38,8 @@
# XXX: unfortunately it doesn't seem to be possible to install
# *UNIVERSAL::AUTOLOAD at the server startup, httpd segfaults,
# child_init seems to be the first stage where it works.
-Apache2->server->push_handlers(PerlChildInitHandler => \&porting_autoload);
+Apache2::ServerUtil->server->push_handlers(
+ PerlChildInitHandler => \&porting_autoload);
sub porting_autoload {
*UNIVERSAL::AUTOLOAD = sub {
diff --git a/lib/ModPerl/BuildMM.pm b/lib/ModPerl/BuildMM.pm
index ed37164..b06a633 100644
--- a/lib/ModPerl/BuildMM.pm
+++ b/lib/ModPerl/BuildMM.pm
@@ -26,6 +26,7 @@
use Apache2::Build ();
use ModPerl::MM;
use constant WIN32 => Apache2::Build::WIN32;
+use constant CYGWIN => Apache2::Build::CYGWIN;
our %PM; #add files to installation
@@ -91,14 +92,16 @@
# usual. This is done for APR in xs/APR/APR/Makefile.PL.
my $name = $args{NAME};
if ($name =~ /^APR::\w+$/) {
- @libs = ($build->apache_libs, $build->mp_apr_lib);
+ # For cygwin compatibility, the order of the libs should be
+ # <mod_perl libs> <apache libs>
+ @libs = ($build->mp_apr_lib, $build->apache_libs);
}
else {
- @libs = ($build->apache_libs, $build->modperl_libs);
+ @libs = ($build->modperl_libs, $build->apache_libs);
}
}
else {
- @libs = ($build->apache_libs, $build->modperl_libs);
+ @libs = ($build->modperl_libs, $build->apache_libs);
}
$libs = join ' ', @libs;
@@ -150,7 +153,7 @@
#skip .xs -> .so if we are linking static
my $name = $self->{NAME};
unless ($always_dynamic{$name}) {
- if (my($xs) = keys %{ $self->{XS} }) {
+ if (my ($xs) = keys %{ $self->{XS} }) {
$self->{HAS_LINK_CODE} = 0;
print "$name will be linked static\n";
#propagate static xs module to src/modules/perl/Makefile
@@ -233,7 +236,7 @@
}
}
- while (my($pm, $blib) = each %pms) {
+ while (my ($pm, $blib) = each %pms) {
$pm =~ s|/\./|/|g; # clean the path
$blib =~ s|/\./|/|g; # clean the path
my @segm = splitdir $blib;
@@ -250,7 +253,8 @@
"-e ModPerl::BuildMM::glue_pod $pm $podpath $blib";
# Win32 doesn't normally install man pages
- next if WIN32;
+ # and Cygwin doesn't allow '::' in file names
+ next if WIN32 || CYGWIN;
# manify while we're at it
my (undef, $man, undef) = $blib =~ m!(blib/lib/)(.*)(\.pm)!;
@@ -282,7 +286,7 @@
sub glue_pod {
die "expecting 3 arguments: pm, pod, dst" unless @ARGV == 3;
- my($pm, $pod, $dst) = @ARGV;
+ my ($pm, $pod, $dst) = @ARGV;
# it's possible that the .pm file is not existing
# (e.g. ThreadMutex.pm is not created on unless
@@ -313,7 +317,7 @@
$build ||= build_config();
my $pm = $self->{PM};
- while (my($k, $v) = each %PM) {
+ while (my ($k, $v) = each %PM) {
if (-e $k) {
$pm->{$k} = $v;
}
@@ -331,7 +335,7 @@
my $apr_config;
sub ModPerl::BuildMM::MY::libscan {
- my($self, $path) = @_;
+ my ($self, $path) = @_;
$apr_config ||= $build->get_apr_config();
diff --git a/lib/ModPerl/BuildOptions.pm b/lib/ModPerl/BuildOptions.pm
index a14a37d..0b3e50a 100644
--- a/lib/ModPerl/BuildOptions.pm
+++ b/lib/ModPerl/BuildOptions.pm
@@ -27,7 +27,7 @@
use File::Spec;
sub init {
- my($self, $build) = @_;
+ my ($self, $build) = @_;
#@ARGV should override what's in .makepl_args.mod_perl2
#but @ARGV might also override the default MP_OPTS_FILE
@@ -68,7 +68,7 @@
}
sub parse {
- my($self, $lines, $opts) = @_;
+ my ($self, $lines, $opts) = @_;
$opts = VERBOSE|UNKNOWN_FATAL unless defined $opts;
my $table = table();
@@ -100,7 +100,7 @@
}
if (/^MP_/) {
- my($key, $val) = split $param_qr, $_, 2;
+ my ($key, $val) = split $param_qr, $_, 2;
$val ||= "" unless defined $val && $val eq '0';
$continue = $val =~ s/\\$// ? $key : "";
@@ -185,7 +185,7 @@
}
sub parse_table {
- my($fh) = @_;
+ my ($fh) = @_;
my %table;
local $_;
@@ -194,7 +194,7 @@
s/^\s+//; s/\s+$//;
next if /^\#/ || /^$/;
last if /^__END__/;
- my($key, $append, $val) = split /\s+/, $_, 3;
+ my ($key, $append, $val) = split /\s+/, $_, 3;
$table{'MP_' . $key} = { append => $append, val => $val };
}
diff --git a/lib/ModPerl/CScan.pm b/lib/ModPerl/CScan.pm
index a7aacf8..3a81fd6 100644
--- a/lib/ModPerl/CScan.pm
+++ b/lib/ModPerl/CScan.pm
@@ -398,7 +398,7 @@
}
sub typedef_structs {
- my($typehash, $structs) = @_;
+ my ($typehash, $structs) = @_;
my %structs;
for (0 .. $#$structs) {
my $in = $structs->[$_];
@@ -411,7 +411,7 @@
my $name = parse_struct($in, \%structs);
$structs{$key} = defined($name) ? $structs{$name} : undef;
}
- while (my($key, $text) = each %$typehash) {
+ while (my ($key, $text) = each %$typehash) {
my $name = parse_struct($text->[0], \%structs);
$structs{$key} = defined($name) ? $structs{$name} : undef;
}
@@ -419,8 +419,8 @@
}
sub parse_struct {
- my($in, $structs) = @_;
- my($b, $e, $chunk, $vars, $struct, $structname);
+ my ($in, $structs) = @_;
+ my ($b, $e, $chunk, $vars, $struct, $structname);
return "$1 $2" if $in =~ /
^ \s* (struct | union) \s+ (\w+) \s* $
/x;
@@ -453,7 +453,7 @@
sub parse_vars {
my $in = shift;
- my($vars, $type, $word, $id, $post, $func);
+ my ($vars, $type, $word, $id, $post, $func);
while ($in =~ /\G\s*([\[;,(]|\*+|:\s*\d+|\S+?\b|$)\s*/gc) {
$word = $1;
@@ -514,7 +514,7 @@
}
sub vdecl_hash {
- my($vdecls, $mdecls) = @_;
+ my ($vdecls, $mdecls) = @_;
my %vdecl_hash;
for (@$vdecls, @$mdecls) {
next if /[()]/; # ignore functions, and function pointers
@@ -556,7 +556,7 @@
$b1 = length $chunk, last unless defined $b1;
}
if ($e - $b - $b1 > 0) {
- my($isvar, $isfunc) = (1, 1);
+ my ($isvar, $isfunc) = (1, 1);
substr ($chunk, 0, $b1) = '';
if ($chunk =~ /,/) { # Contains multiple declarations.
push @mdecls, $b + $b1, $e;
@@ -940,7 +940,7 @@
my $addincludes = "";
$addincludes = "-I" . join(" -I", @$Includes)
if defined $Includes and @$Includes;
- my($sym) = gensym;
+ my ($sym) = gensym;
my $cmd = WIN32 ?
"$Cpp->{cppstdin} $Defines $addincludes $Cpp->{cppflags} $filename |" :
"echo '\#include \"$filename\"' | $Cpp->{cppstdin} $Defines $addincludes $Cpp->{cppflags} $Cpp->{cppminus} |";
diff --git a/lib/ModPerl/Code.pm b/lib/ModPerl/Code.pm
index a1c7392..700ff40 100644
--- a/lib/ModPerl/Code.pm
+++ b/lib/ModPerl/Code.pm
@@ -125,7 +125,7 @@
}
}
-while (my($k,$v) = each %directive_proto) {
+while (my ($k,$v) = each %directive_proto) {
$directive_proto{$k}->{ret} = 'const char *';
my $handlers = join '_', 'handlers', canon_lc($k);
$directive_proto{$k}->{handlers} =
@@ -168,9 +168,9 @@
sub path { shift->{path} }
sub handler_desc {
- my($self, $h_add, $c_add) = @_;
+ my ($self, $h_add, $c_add) = @_;
local $" = ",\n";
- while (my($class, $h) = each %{ $self->{handler_index_desc} }) {
+ while (my ($class, $h) = each %{ $self->{handler_index_desc} }) {
my $func = canon_func('handler', 'desc', $class);
my $array = join '_', 'MP', $func;
my $proto = "const char *$func(int idx)";
@@ -192,11 +192,11 @@
}
sub generate_handler_index {
- my($self, $h_fh) = @_;
+ my ($self, $h_fh) = @_;
my $type = 1;
- while (my($class, $handlers) = each %{ $self->{handlers} }) {
+ while (my ($class, $handlers) = each %{ $self->{handlers} }) {
my $i = 0;
my $n = @$handlers;
my $handler_type = canon_define('HANDLER_TYPE', $class);
@@ -220,11 +220,11 @@
}
sub generate_handler_hooks {
- my($self, $h_fh, $c_fh) = @_;
+ my ($self, $h_fh, $c_fh) = @_;
my @register_hooks;
- while (my($class, $prototype) = each %{ $self->{hook_proto} }) {
+ while (my ($class, $prototype) = each %{ $self->{hook_proto} }) {
my $callback = canon_func('callback', $class);
my $return = $prototype->{ret} eq 'void' ? '' : 'return';
my $i = -1;
@@ -243,7 +243,7 @@
" ap_hook_$hook($name, NULL, NULL, $order);";
}
- my($protostr, $pass) = canon_proto($prototype, $name);
+ my ($protostr, $pass) = canon_proto($prototype, $name);
my $ix = $self->{handler_index}->{$class}->[$i];
if ($callback =~ m/modperl_callback_per_(dir|srv)/) {
@@ -275,10 +275,10 @@
}
sub generate_handler_find {
- my($self, $h_fh, $c_fh) = @_;
+ my ($self, $h_fh, $c_fh) = @_;
my $proto = 'int modperl_handler_lookup(const char *name, int *type)';
- my(%ix, %switch);
+ my (%ix, %switch);
print $h_fh "$proto;\n";
@@ -292,7 +292,7 @@
switch (*name) {
EOF
- while (my($class, $handlers) = each %{ $self->{handlers} }) {
+ while (my ($class, $handlers) = each %{ $self->{handlers} }) {
my $i = 0;
for my $name (@$handlers) {
@@ -334,11 +334,11 @@
}
sub generate_handler_directives {
- my($self, $h_fh, $c_fh) = @_;
+ my ($self, $h_fh, $c_fh) = @_;
my @cmd_entries;
- while (my($class, $handlers) = each %{ $self->{handlers} }) {
+ while (my ($class, $handlers) = each %{ $self->{handlers} }) {
my $prototype = $self->{directive_proto}->{$class};
my $i = 0;
@@ -391,7 +391,7 @@
}
sub generate_flags {
- my($self, $h_fh, $c_fh) = @_;
+ my ($self, $h_fh, $c_fh) = @_;
my $n = 1;
@@ -399,7 +399,7 @@
print $h_fh "\n#define MP_SYS_$dlsrc 1\n";
- while (my($class, $opts) = each %{ $self->{flags} }) {
+ while (my ($class, $opts) = each %{ $self->{flags} }) {
my @lookup = ();
my %lookup = ();
my $lookup_proto = "";
@@ -499,7 +499,7 @@
);
sub generate_trace {
- my($self, $h_fh) = @_;
+ my ($self, $h_fh) = @_;
my $v = $self->{build}->{VERSION};
my $api_v = $self->{build}->{API_VERSION};
@@ -560,7 +560,7 @@
}
sub generate_largefiles {
- my($self, $h_fh) = @_;
+ my ($self, $h_fh) = @_;
my $flags = $self->perl_config('ccflags_uselargefiles');
@@ -568,7 +568,7 @@
for my $flag (split /\s+/, $flags) {
next if $flag =~ /^-/; # skip -foo flags
- my($name, $val) = split '=', $flag;
+ my ($name, $val) = split '=', $flag;
$val ||= '';
$name =~ s/^-D//;
print $h_fh "#define $name $val\n";
@@ -619,8 +619,8 @@
}
sub canon_proto {
- my($prototype, $name) = @_;
- my($in,$pass) = canon_args($prototype);
+ my ($prototype, $name) = @_;
+ my ($in,$pass) = canon_args($prototype);
local $" = ', ';
@@ -710,12 +710,12 @@
}
sub init_file {
- my($self, $name) = @_;
+ my ($self, $name) = @_;
return unless $name;
return if $self->{init_files}->{$name}++;
- my(@preamble);
+ my (@preamble);
if ($name =~ /\.h$/) {
(my $d = uc $name) =~ s/\./_/;
push @preamble, "#ifndef $d\n#define $d\n";
@@ -735,7 +735,7 @@
}
sub fh {
- my($self, $name) = @_;
+ my ($self, $name) = @_;
return unless $name;
$self->{fh}->{$name};
}
@@ -749,7 +749,7 @@
}
sub generate {
- my($self, $build) = @_;
+ my ($self, $build) = @_;
$self->{build} = $build;
@@ -760,10 +760,10 @@
}
for my $method (reverse sort keys %sources) {
- my($h_fh, $c_fh) = map {
+ my ($h_fh, $c_fh) = map {
$self->fh($sources{$method}->{$_});
} qw(h c);
- my($h_add, $c_add) = $self->$method($h_fh, $c_fh);
+ my ($h_add, $c_add) = $self->$method($h_fh, $c_fh);
if ($h_add) {
print $h_fh $h_add;
}
@@ -788,7 +788,7 @@
my $constant_prefixes = join '|', qw{APR? MODPERL_RC};
sub generate_constants {
- my($self, $h_fh, $c_fh) = @_;
+ my ($self, $h_fh, $c_fh) = @_;
require Apache2::ConstantsTable;
@@ -827,16 +827,16 @@
}
sub constants_lookup_code {
- my($h_fh, $c_fh, $constants, $class) = @_;
+ my ($h_fh, $c_fh, $constants, $class) = @_;
- my(%switch, %alias);
+ my (%switch, %alias);
%alias = %shortcuts;
my $postfix = canon_lc(lc $class);
my $package = $class . '::';
my $package_len = length $package;
- my($first_let) = $class =~ /^(\w)/;
+ my ($first_let) = $class =~ /^(\w)/;
my $func = canon_func(qw(constants lookup), $postfix);
my $proto = "SV \*$func(pTHX_ const char *name)";
@@ -906,9 +906,9 @@
}
sub generate_constants_lookup {
- my($h_fh, $c_fh) = @_;
+ my ($h_fh, $c_fh) = @_;
- while (my($class, $groups) = each %$Apache2::ConstantsTable) {
+ while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
my $constants = [map { @$_ } values %$groups];
constants_lookup_code($h_fh, $c_fh, $constants, $class);
@@ -916,20 +916,20 @@
}
sub generate_constants_group_lookup {
- my($h_fh, $c_fh) = @_;
+ my ($h_fh, $c_fh) = @_;
- while (my($class, $groups) = each %$Apache2::ConstantsTable) {
+ while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
constants_group_lookup_code($h_fh, $c_fh, $class, $groups);
}
}
sub constants_group_lookup_code {
- my($h_fh, $c_fh, $class, $groups) = @_;
+ my ($h_fh, $c_fh, $class, $groups) = @_;
my @tags;
my @code;
$class = canon_lc(lc $class);
- while (my($group, $constants) = each %$groups) {
+ while (my ($group, $constants) = each %$groups) {
push @tags, $group;
my $name = join '_', 'MP_constants', $class, $group;
print $c_fh "\nstatic const char *$name [] = { \n",
@@ -974,7 +974,7 @@
my %seen_const = ();
# generates APR::Const and Apache2::Const manpages in ./tmp/
sub generate_constants_pod {
- my($self) = @_;
+ my ($self) = @_;
my %data = ();
generate_constants_group_lookup_doc(\%data);
@@ -1026,9 +1026,9 @@
}
sub generate_constants_lookup_doc {
- my($data) = @_;
+ my ($data) = @_;
- while (my($class, $groups) = each %$Apache2::ConstantsTable) {
+ while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
my $constants = [map { @$_ } values %$groups];
constants_lookup_code_doc($constants, $class, $data);
@@ -1036,19 +1036,19 @@
}
sub generate_constants_group_lookup_doc {
- my($data) = @_;
+ my ($data) = @_;
- while (my($class, $groups) = each %$Apache2::ConstantsTable) {
+ while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
constants_group_lookup_code_doc($class, $groups, $data);
}
}
sub constants_group_lookup_code_doc {
- my($class, $groups, $data) = @_;
+ my ($class, $groups, $data) = @_;
my @tags;
my @code;
- while (my($group, $constants) = each %$groups) {
+ while (my ($group, $constants) = each %$groups) {
$data->{$class}{$group} = [
map {
my @ifdef = constants_ifdef($_);
@@ -1061,9 +1061,9 @@
}
sub constants_lookup_code_doc {
- my($constants, $class, $data) = @_;
+ my ($constants, $class, $data) = @_;
- my(%switch, %alias);
+ my (%switch, %alias);
%alias = %shortcuts;
@@ -1095,7 +1095,7 @@
}
sub generate_exports {
- my($self, $c_fh) = @_;
+ my ($self, $c_fh) = @_;
require ModPerl::WrapXS;
ModPerl::WrapXS->generate_exports($c_fh);
}
diff --git a/lib/ModPerl/FunctionMap.pm b/lib/ModPerl/FunctionMap.pm
index bea5f10..ee85d5f 100644
--- a/lib/ModPerl/FunctionMap.pm
+++ b/lib/ModPerl/FunctionMap.pm
@@ -76,7 +76,7 @@
sub guess_prefix {
my $entry = shift;
- my($name, $class) = ($entry->{name}, $entry->{class});
+ my ($name, $class) = ($entry->{name}, $entry->{class});
my $prefix = "";
$name =~ s/^DEFINE_//;
$name =~ s/^mpxs_//i;
@@ -101,7 +101,7 @@
}
sub parse {
- my($self, $fh, $map) = @_;
+ my ($self, $fh, $map) = @_;
my %cur;
my $disabled = 0;
@@ -125,7 +125,7 @@
next;
}
- my($name, $dispatch, $argspec, $alias) = split /\s*\|\s*/;
+ my ($name, $dispatch, $argspec, $alias) = split /\s*\|\s*/;
my $return_type;
if ($name =~ s/^([^:]+)://) {
@@ -200,7 +200,7 @@
my $map = $self->get;
my %prefix;
- while (my($name, $ent) = each %$map) {
+ while (my ($name, $ent) = each %$map) {
next unless $ent->{prefix};
$prefix{ $ent->{prefix} }++;
}
diff --git a/lib/ModPerl/MM.pm b/lib/ModPerl/MM.pm
index 1f66ea0..2a2e7d8 100644
--- a/lib/ModPerl/MM.pm
+++ b/lib/ModPerl/MM.pm
@@ -54,17 +54,17 @@
}
sub add_dep {
- my($string, $targ, $add) = @_;
+ my ($string, $targ, $add) = @_;
$$string =~ s/($targ\s+::)/$1 $add/;
}
sub add_dep_before {
- my($string, $targ, $before_targ, $add) = @_;
+ my ($string, $targ, $before_targ, $add) = @_;
$$string =~ s/($targ\s+::.*?) ($before_targ)/$1 $add $2/;
}
sub add_dep_after {
- my($string, $targ, $after_targ, $add) = @_;
+ my ($string, $targ, $after_targ, $add) = @_;
$$string =~ s/($targ\s+::.*?$after_targ)/$1 $add/;
}
@@ -160,7 +160,7 @@
my $build = build_config();
my $pm = $self->{PM};
- while (my($k, $v) = each %PM) {
+ while (my ($k, $v) = each %PM) {
if (-e $k) {
$pm->{$k} = $v;
}
diff --git a/lib/ModPerl/Manifest.pm b/lib/ModPerl/Manifest.pm
index d1ebab8..ebf5717 100644
--- a/lib/ModPerl/Manifest.pm
+++ b/lib/ModPerl/Manifest.pm
@@ -99,7 +99,7 @@
}
my $sub = "\$matches = "
- . "sub { my(\$arg)=\@_; return 1 if "
+ . "sub { my (\$arg)=\@_; return 1 if "
. join (" || ", (map {s!/!\\/!g; "\$arg =~ m/$_/o"} @skip), 0)
. " }";
diff --git a/lib/ModPerl/MapUtil.pm b/lib/ModPerl/MapUtil.pm
index 15c76f7..a75f497 100644
--- a/lib/ModPerl/MapUtil.pm
+++ b/lib/ModPerl/MapUtil.pm
@@ -114,9 +114,9 @@
my $self = shift;
my $package = ref($self) || $self;
- my($wanted) = $package =~ /($map_classes)/io;
+ my ($wanted) = $package =~ /($map_classes)/io;
- my(@dirs) = (($MapDir || './xs'), ModPerl::MapUtil::xs_glue_dirs());
+ my (@dirs) = (($MapDir || './xs'), ModPerl::MapUtil::xs_glue_dirs());
my @files;
@@ -143,11 +143,11 @@
}
sub parse_keywords {
- my($self, $line) = @_;
+ my ($self, $line) = @_;
my %words;
for my $pair (split /\s+/, $line) {
- my($key, $val) = split /=/, $pair;
+ my ($key, $val) = split /=/, $pair;
unless ($key and $val) {
die "parse error ($ModPerl::MapUtil::MapFile line $.)";
@@ -160,7 +160,7 @@
}
sub parse_map_files {
- my($self) = @_;
+ my ($self) = @_;
my $map = {};
diff --git a/lib/ModPerl/StructureMap.pm b/lib/ModPerl/StructureMap.pm
index 706f2d1..778c4ab 100644
--- a/lib/ModPerl/StructureMap.pm
+++ b/lib/ModPerl/StructureMap.pm
@@ -80,7 +80,7 @@
my @missing;
- while (my($type, $elts) = each %{ $self->{map} }) {
+ while (my ($type, $elts) = each %{ $self->{map} }) {
for my $name (keys %$elts) {
next if exists $structures{$type}->{$name};
push @missing, "$type.$name";
@@ -91,9 +91,9 @@
}
sub parse {
- my($self, $fh, $map) = @_;
+ my ($self, $fh, $map) = @_;
- my($disabled, $class);
+ my ($disabled, $class);
my %cur;
while ($fh->readline) {
diff --git a/lib/ModPerl/TypeMap.pm b/lib/ModPerl/TypeMap.pm
index 3df7d82..226c5e5 100644
--- a/lib/ModPerl/TypeMap.pm
+++ b/lib/ModPerl/TypeMap.pm
@@ -42,7 +42,7 @@
my %special = map { $_, 1 } qw(UNDEFINED NOTIMPL CALLBACK);
sub special {
- my($self, $class) = @_;
+ my ($self, $class) = @_;
return $special{$class};
}
@@ -50,19 +50,19 @@
sub structure_map { shift->{structure_map}->get }
sub parse {
- my($self, $fh, $map) = @_;
+ my ($self, $fh, $map) = @_;
while ($fh->readline) {
if (/E=/) {
my %args = $self->parse_keywords($_);
- while (my($key,$val) = each %args) {
+ while (my ($key,$val) = each %args) {
push @{ $self->{$key} }, $val;
}
next;
}
my @aliases;
- my($type, $class) = (split /\s*\|\s*/, $_)[0,1];
+ my ($type, $class) = (split /\s*\|\s*/, $_)[0,1];
$class ||= 'UNDEFINED';
if ($type =~ s/^(struct|typedef)\s+(.*)/$2/) {
@@ -106,17 +106,17 @@
};
sub should_ignore {
- my($self, $type) = @_;
+ my ($self, $type) = @_;
return 1 if $type =~ /^($ignore)/o;
}
sub is_callback {
- my($self, $type) = @_;
+ my ($self, $type) = @_;
return 1 if $type =~ /\(/ and $type =~ /\)/; #XXX: callback
}
sub exists {
- my($self, $type) = @_;
+ my ($self, $type) = @_;
return 1 if $self->is_callback($type) || $self->should_ignore($type);
@@ -126,7 +126,7 @@
}
sub map_type {
- my($self, $type) = @_;
+ my ($self, $type) = @_;
my $class = $self->get->{$type};
return unless $class and ! $self->special($class);
@@ -140,7 +140,7 @@
}
sub null_type {
- my($self, $type) = @_;
+ my ($self, $type) = @_;
my $class = $self->get->{$type};
if ($class =~ /^[INU]V/) {
@@ -165,7 +165,7 @@
}
sub map_arg {
- my($self, $arg) = @_;
+ my ($self, $arg) = @_;
my $map_type = $self->map_type($arg->{type});
die "unknown typemap: '$arg->{type}'" unless defined $map_type;
@@ -179,7 +179,7 @@
}
sub map_args {
- my($self, $func) = @_;
+ my ($self, $func) = @_;
my $entry = $self->function_map->{ $func->{name} };
my $argspec = $entry->{argspec};
@@ -191,7 +191,7 @@
for my $arg (@$argspec) {
my $default;
($arg, $default) = split /=/, $arg, 2;
- my($type, $name) = split ':', $arg, 2;
+ my ($type, $name) = split ':', $arg, 2;
if ($type and $name) {
push @$args, {
@@ -224,7 +224,7 @@
#this is needed for modperl-only functions
#unlike apache/apr functions which are remapped to a mpxs_ function
sub thx_fixup {
- my($self, $func) = @_;
+ my ($self, $func) = @_;
my $first = $func->{args}->[0];
@@ -237,14 +237,14 @@
}
sub map_function {
- my($self, $func) = @_;
+ my ($self, $func) = @_;
my $map = $self->function_map->{ $func->{name} };
return unless $map;
$self->thx_fixup($func);
- my($status, $failed_type) =
+ my ($status, $failed_type) =
$self->can_map($map, $func->{return_type},
map $_->{type}, @{ $func->{args} });
@@ -282,15 +282,15 @@
}
sub map_structure {
- my($self, $struct) = @_;
+ my ($self, $struct) = @_;
- my($class, @elts);
+ my ($class, @elts);
my $stype = $struct->{type};
return unless $class = $self->map_type($stype);
for my $e (@{ $struct->{elts} }) {
- my($name, $type) = ($e->{name}, $e->{type});
+ my ($name, $type) = ($e->{name}, $e->{type});
my $rtype;
# ro/rw/r+w_startup/undef(disabled)
@@ -317,12 +317,12 @@
}
sub destructor {
- my($self, $prefix) = @_;
+ my ($self, $prefix) = @_;
$self->function_map->{$prefix . 'DESTROY'};
}
sub first_class {
- my($self, $func) = @_;
+ my ($self, $func) = @_;
for my $e (@{ $func->{args} }) {
next unless $e->{type} =~ /::/;
@@ -338,7 +338,7 @@
sub check {
my $self = shift;
- my(@types, @missing, %seen);
+ my (@types, @missing, %seen);
require Apache2::StructureTable;
for my $entry (@$Apache2::StructureTable) {
@@ -396,7 +396,7 @@
};
sub class_pool : lvalue {
- my($self, $class) = @_;
+ my ($self, $class) = @_;
$class_pools{$class};
}
@@ -416,7 +416,7 @@
};
sub h_wrap {
- my($self, $file, $code) = @_;
+ my ($self, $file, $code) = @_;
$file = 'modperl_xs_' . $file;
@@ -468,7 +468,7 @@
my %seen;
my $code = "";
- while (my($ctype, $ptype) = each %$map) {
+ while (my ($ctype, $ptype) = each %$map) {
next if $self->special($ptype);
next if $ctype =~ /\s/;
my $class = $ptype;
diff --git a/lib/ModPerl/WrapXS.pm b/lib/ModPerl/WrapXS.pm
index 5850388..eb936e1 100644
--- a/lib/ModPerl/WrapXS.pm
+++ b/lib/ModPerl/WrapXS.pm
@@ -30,7 +30,7 @@
our $VERSION = '0.01';
-my(@xs_includes) = ('mod_perl.h',
+my (@xs_includes) = ('mod_perl.h',
map "modperl_xs_$_.h", qw(sv_convert util typedefs));
my @global_structs = qw(perl_module);
@@ -57,9 +57,9 @@
sub function_list {
my $self = shift;
- my(@list) = @{ function_table() };
+ my (@list) = @{ function_table() };
- while (my($name, $val) = each %{ $self->typemap->function_map }) {
+ while (my ($name, $val) = each %{ $self->typemap->function_map }) {
#entries that do not exist in C::Scan generated tables
next unless $name =~ /^DEFINE_/;
push @list, $val;
@@ -77,7 +77,7 @@
#print "FAILED to map $entry->{name}\n" unless $func;
next unless $func;
- my($name, $module, $class, $args) =
+ my ($name, $module, $class, $args) =
@{ $func } { qw(perl_name module class args) };
$self->{XS}->{ $module } ||= [];
@@ -101,7 +101,7 @@
my $proto = join "\n",
(map " $_->{type} $_->{name}", @$args), "";
- my($dispatch, $orig_args) =
+ my ($dispatch, $orig_args) =
@{ $func } {qw(dispatch orig_args)};
if ($dispatch =~ /^MPXS_/) {
@@ -195,7 +195,7 @@
my $class = $struct->{class};
for my $e (@{ $struct->{elts} }) {
- my($name, $default, $type, $access_mode) =
+ my ($name, $default, $type, $access_mode) =
@{$e}{qw(name default type access_mode)};
(my $cast = $type) =~ s/:/_/g;
@@ -346,15 +346,15 @@
}
sub class_dirname {
- my($self, $class) = @_;
- my($base, $sub) = split '::', $class;
+ my ($self, $class) = @_;
+ my ($base, $sub) = split '::', $class;
return "$self->{DIR}/$base" unless $sub; #Apache2 | APR
return $sub if $sub eq $self->{DIR}; #WrapXS
return "$base/$sub";
}
sub class_dir {
- my($self, $class) = @_;
+ my ($self, $class) = @_;
my $dirname = $self->class_dirname($class);
my $dir = ($dirname =~ m:/: and $dirname !~ m:^$self->{DIR}:) ?
@@ -369,18 +369,18 @@
}
sub class_file {
- my($self, $class, $file) = @_;
+ my ($self, $class, $file) = @_;
catfile $self->class_dir($class), $file;
}
sub cname {
- my($self, $class) = @_;
+ my ($self, $class) = @_;
$class =~ s/:/_/g;
$class;
}
sub open_class_file {
- my($self, $class, $file) = @_;
+ my ($self, $class, $file) = @_;
if ($file =~ /^\./) {
my $sub = (split '::', $class)[-1];
@@ -403,7 +403,7 @@
}
sub write_makefilepl {
- my($self, $class) = @_;
+ my ($self, $class) = @_;
my $fh = $self->open_class_file($class, 'Makefile.PL');
@@ -439,7 +439,7 @@
}
sub mod_h {
- my($self, $module, $complete) = @_;
+ my ($self, $module, $complete) = @_;
my $dirname = $self->class_dirname($module);
my $cname = $self->cname($module);
@@ -455,10 +455,10 @@
}
sub mod_pm {
- my($self, $module, $complete) = @_;
+ my ($self, $module, $complete) = @_;
my $dirname = $self->class_dirname($module);
- my($base, $sub) = split '::', $module;
+ my ($base, $sub) = split '::', $module;
my $mod_pm = "$dirname/${sub}_pm";
for ($self->{XS_DIR}, @{ $self->{glue_dirs} }) {
@@ -488,18 +488,18 @@
}
sub make_prefix {
- my($name, $class) = @_;
+ my ($name, $class) = @_;
my $class_prefix = class_mpxs_prefix($class);
return $name if $name =~ /^$class_prefix/;
$class_prefix . $name;
}
sub isa_str {
- my($self, $module) = @_;
+ my ($self, $module) = @_;
my $str = "";
if (my $isa = $self->typemap->{function_map}->{isa}->{$module}) {
- while (my($sub, $base) = each %$isa) {
+ while (my ($sub, $base) = each %$isa) {
#XXX cannot set isa in the BOOT: section because XSLoader local-ises
#ISA during bootstrap
# $str .= qq{ av_push(get_av("$sub\::ISA", TRUE),
@@ -512,7 +512,7 @@
}
sub boot {
- my($self, $module) = @_;
+ my ($self, $module) = @_;
my $str = "";
if (my $boot = $self->typemap->{function_map}->{boot}->{$module}) {
@@ -525,7 +525,7 @@
my $notshared = join '|', qw(TIEHANDLE); #not sure why yet
sub attrs {
- my($self, $name) = @_;
+ my ($self, $name) = @_;
my $str = "";
return $str if $name =~ /$notshared$/o;
$str = " ATTRS: unique\n" if GvUNIQUE;
@@ -533,7 +533,7 @@
}
sub write_xs {
- my($self, $module, $functions) = @_;
+ my ($self, $module, $functions) = @_;
my $fh = $self->open_class_file($module, '.xs');
print $fh $self->ModPerl::Code::noedit_warning_c(), "\n";
@@ -602,7 +602,7 @@
}
sub write_pm {
- my($self, $module) = @_;
+ my ($self, $module) = @_;
my $isa = $self->isa_str($module);
@@ -667,7 +667,7 @@
my %entries = ();
my $max_key_len = 0;
- while (my($type, $class) = each %$map) {
+ while (my ($type, $class) = each %$map) {
$class ||= $type;
next if $seen{$type}++ || $typemap->special($class);
@@ -689,10 +689,10 @@
}
sub write_typemap_h_file {
- my($self, $method) = @_;
+ my ($self, $method) = @_;
$method = $method . '_code';
- my($h, $code) = $self->typemap->$method();
+ my ($h, $code) = $self->typemap->$method();
my $file = catfile $self->{XS_DIR}, $h;
open my $fh, '>', $file or die "open $file: $!";
@@ -705,7 +705,7 @@
my $self = shift;
my %map = ();
- while (my($module, $functions) = each %{ $self->{XS} }) {
+ while (my ($module, $functions) = each %{ $self->{XS} }) {
my $last_prefix = "";
for my $func (@$functions) {
my $class = $func->{class};
@@ -1164,8 +1164,8 @@
$self->write_export_file('exp') if Apache2::Build::AIX;
$self->write_export_file('def') if Apache2::Build::WIN32;
- while (my($module, $functions) = each %{ $self->{XS} }) {
-# my($root, $sub) = split '::', $module;
+ while (my ($module, $functions) = each %{ $self->{XS} }) {
+# my ($root, $sub) = split '::', $module;
# if (-e "$self->{XS_DIR}/$root/$sub/$sub.xs") {
# $module = join '::', $root, "Wrap$sub";
# }
@@ -1188,7 +1188,7 @@
my %multi_export = map { $_, 1 } qw(exp);
sub open_export_files {
- my($self, $name, $ext) = @_;
+ my ($self, $name, $ext) = @_;
my $dir = $self->{XS_DIR};
my %handles;
@@ -1221,7 +1221,7 @@
}
sub func_is_static {
- my($self, $entry) = @_;
+ my ($self, $entry) = @_;
if (my $attr = $entry->{attr}) {
return 1 if grep { $_ eq 'static' } @$attr;
}
@@ -1233,7 +1233,7 @@
}
sub func_is_inline {
- my($self, $entry) = @_;
+ my ($self, $entry) = @_;
if (my $attr = $entry->{attr}) {
return 1 if grep { $_ eq '__inline__' } @$attr;
}
@@ -1246,7 +1246,7 @@
}
sub export_file_format_exp {
- my($self, $val) = @_;
+ my ($self, $val) = @_;
"$val\n";
}
@@ -1256,7 +1256,7 @@
}
sub export_file_format_def {
- my($self, $val) = @_;
+ my ($self, $val) = @_;
" $val\n";
}
@@ -1270,7 +1270,7 @@
};
sub export_func_handle {
- my($self, $entry, $handles) = @_;
+ my ($self, $entry, $handles) = @_;
if ($self->func_is_inline($entry)) {
return $handles->{inline};
@@ -1283,7 +1283,7 @@
}
sub write_export_file {
- my($self, $ext) = @_;
+ my ($self, $ext) = @_;
my %files = (
modperl => $ModPerl::FunctionTable,
@@ -1294,7 +1294,7 @@
my $header = \&{"export_file_header_$ext"};
my $format = \&{"export_file_format_$ext"};
- while (my($key, $table) = each %files) {
+ while (my ($key, $table) = each %files) {
my $handles = $self->open_export_files($key, $ext);
my %seen; #only write header once if this is a single file
@@ -1336,7 +1336,7 @@
my %stats;
- while (my($module, $functions) = each %{ $self->{XS} }) {
+ while (my ($module, $functions) = each %{ $self->{XS} }) {
$stats{$module} += @$functions;
if (my $newxs = $self->{newXS}->{$module}) {
$stats{$module} += @$newxs;
@@ -1347,7 +1347,7 @@
}
sub generate_exports {
- my($self, $fh) = @_;
+ my ($self, $fh) = @_;
if (!$build->should_build_apache) {
print $fh <<"EOF";
diff --git a/src/modules/perl/modperl_filter.c b/src/modules/perl/modperl_filter.c
index 273aacc..513195a 100644
--- a/src/modules/perl/modperl_filter.c
+++ b/src/modules/perl/modperl_filter.c
@@ -544,6 +544,15 @@
if (filter->mode == MP_INPUT_FILTER_MODE) {
if (filter->bb_in) {
+ if (status == DECLINED) {
+ /* make sure the filter doesn't try to make mod_perl
+ * pass the bucket brigade through after it called
+ * $f->read(), since it causes a pre-fetch of the
+ * bb */
+ modperl_croak(aTHX_ MODPERL_FILTER_ERROR,
+ "a filter calling $f->read "
+ "must return OK and not DECLINED");
+ }
/* in the streaming mode filter->bb_in is populated on the
* first modperl_input_filter_read, so it must be
* destroyed at the end of the filter invocation
diff --git a/t/apache/content_length_header.t b/t/apache/content_length_header.t
index be357d1..b38b8ad 100644
--- a/t/apache/content_length_header.t
+++ b/t/apache/content_length_header.t
@@ -5,10 +5,7 @@
use Apache::TestUtil;
use Apache::TestRequest;
-my $skip = skip_reason('investigating 2.1 C-L behaviors')
- if have_min_apache_version(2.1);
-
-plan tests => 12 * 2 + 3, $skip;
+plan tests => 12 * 2 + 3;
my $location = "/TestApache__content_length_header";
@@ -46,9 +43,9 @@
my $uri = $location;
my $res = $method->($uri);
- my $cl = have_min_apache_version(2.1) ? undef : 0;
- my $head_cl = have_min_apache_version(2.1) ? $cl : undef;
-
+ my $cl = 0;
+ my $head_cl = undef;
+
ok t_cmp $res->code, 200, "$method $uri code";
ok t_cmp ($res->header('Content-Length'),
$method eq 'GET' ? $cl : $head_cl,
@@ -67,8 +64,8 @@
my $uri = "$location?set_content_length";
my $res = $method->($uri);
- my $cl = have_min_apache_version(2.1) ? 25 : 0;
- my $head_cl = have_min_apache_version(2.1) ? $cl : undef;
+ my $cl = 0;
+ my $head_cl = undef;
ok t_cmp $res->code, 200, "$method $uri code";
ok t_cmp ($res->header('Content-Length'),
diff --git a/t/api/internal_redirect.t b/t/api/internal_redirect.t
index c922573..421f41a 100644
--- a/t/api/internal_redirect.t
+++ b/t/api/internal_redirect.t
@@ -20,7 +20,7 @@
plan tests => scalar keys %map;
-while (my($key, $val) = each %map) {
+while (my ($key, $val) = each %map) {
my $expected = "internal redirect: $key";
my $received = GET_BODY_ASSERT $val;
ok t_cmp($received, $expected);
diff --git a/t/api/lookup_uri.t b/t/api/lookup_uri.t
index 6311fca..ad07d44 100644
--- a/t/api/lookup_uri.t
+++ b/t/api/lookup_uri.t
@@ -19,7 +19,7 @@
plan tests => scalar keys %opts;
-while (my($filter, $runs) = each %opts) {
+while (my ($filter, $runs) = each %opts) {
my $args = "subreq=lookup_uri;filter=$filter";
my $prefix = "pre+" x $runs->[PREFIX];
my $suffix = "+suf" x $runs->[SUFFIX];
diff --git a/t/compat/request_body.t b/t/compat/request_body.t
index a322c92..6ee7029 100644
--- a/t/compat/request_body.t
+++ b/t/compat/request_body.t
@@ -73,7 +73,7 @@
### helper subs ###
sub query {
- my(%args) = (@_ % 2) ? %{+shift} : @_;
+ my (%args) = (@_ % 2) ? %{+shift} : @_;
"$location?" . join '&', map { "$_=$args{$_}" } keys %args;
}
diff --git a/t/conf/modperl_extra.pl b/t/conf/modperl_extra.pl
index e6da78b..1754372 100644
--- a/t/conf/modperl_extra.pl
+++ b/t/conf/modperl_extra.pl
@@ -128,7 +128,7 @@
PerlPostConfigHandler => \&add_my_version);
sub add_my_version {
- my($conf_pool, $log_pool, $temp_pool, $s) = @_;
+ my ($conf_pool, $log_pool, $temp_pool, $s) = @_;
$s->add_version_component("world domination series/2.0");
return Apache2::Const::OK;
}
diff --git a/t/conf/post_config_startup.pl b/t/conf/post_config_startup.pl
index 1ef4e6a..8bc9947 100644
--- a/t/conf/post_config_startup.pl
+++ b/t/conf/post_config_startup.pl
@@ -81,7 +81,7 @@
Apache2::Status->menu_item(
'test_menu' => "Test Menu Entry",
sub {
- my($r) = @_;
+ my ($r) = @_;
return ["This is just a test entry"];
}
) if Apache2::Module::loaded('Apache2::Status');
@@ -130,7 +130,7 @@
}
sub ModPerl::Test::exit_handler {
- my($p, $s) = @_;
+ my ($p, $s) = @_;
$s->log->info("Child process pid=$$ is exiting");
diff --git a/t/directive/setupenv.t b/t/directive/setupenv.t
index e0c140a..fde3b5c 100644
--- a/t/directive/setupenv.t
+++ b/t/directive/setupenv.t
@@ -17,7 +17,7 @@
for my $line (split /\n/, $env) {
next unless $line =~ /=/;
- my($key, $val) = split /=/, $line, 2;
+ my ($key, $val) = split /=/, $line, 2;
$env{$key} = $val || '';
}
diff --git a/t/filter/TestFilter/in_bbs_body.pm b/t/filter/TestFilter/in_bbs_body.pm
index 894eef4..24830e9 100644
--- a/t/filter/TestFilter/in_bbs_body.pm
+++ b/t/filter/TestFilter/in_bbs_body.pm
@@ -16,7 +16,7 @@
use APR::Const -compile => ':common';
sub handler : FilterRequestHandler {
- my($filter, $bb, $mode, $block, $readbytes) = @_;
+ my ($filter, $bb, $mode, $block, $readbytes) = @_;
$filter->next->get_brigade($bb, $mode, $block, $readbytes);
diff --git a/t/filter/TestFilter/in_bbs_consume.pm b/t/filter/TestFilter/in_bbs_consume.pm
index a936fde..da05276 100644
--- a/t/filter/TestFilter/in_bbs_consume.pm
+++ b/t/filter/TestFilter/in_bbs_consume.pm
@@ -24,7 +24,7 @@
use constant READ_SIZE => 26;
sub handler {
- my($filter, $bb, $mode, $block, $readbytes) = @_;
+ my ($filter, $bb, $mode, $block, $readbytes) = @_;
my $ba = $filter->r->connection->bucket_alloc;
my $seen_eos = 0;
my $satisfied = 0;
diff --git a/t/filter/TestFilter/in_bbs_inject_header.pm b/t/filter/TestFilter/in_bbs_inject_header.pm
index f4daa67..f6b800a 100644
--- a/t/filter/TestFilter/in_bbs_inject_header.pm
+++ b/t/filter/TestFilter/in_bbs_inject_header.pm
@@ -119,7 +119,7 @@
}
sub handler : FilterConnectionHandler {
- my($filter, $bb, $mode, $block, $readbytes) = @_;
+ my ($filter, $bb, $mode, $block, $readbytes) = @_;
debug join '', "-" x 20 , " input filter called -", "-" x 20;
diff --git a/t/filter/TestFilter/in_bbs_msg.pm b/t/filter/TestFilter/in_bbs_msg.pm
index 2be046d..db2153c 100644
--- a/t/filter/TestFilter/in_bbs_msg.pm
+++ b/t/filter/TestFilter/in_bbs_msg.pm
@@ -19,7 +19,7 @@
my $to_url = '/TestFilter__in_bbs_msg';
sub handler : FilterConnectionHandler {
- my($filter, $bb, $mode, $block, $readbytes) = @_;
+ my ($filter, $bb, $mode, $block, $readbytes) = @_;
debug "FILTER CALLED";
diff --git a/t/filter/TestFilter/in_bbs_underrun.pm b/t/filter/TestFilter/in_bbs_underrun.pm
index b265f85..70b0196 100644
--- a/t/filter/TestFilter/in_bbs_underrun.pm
+++ b/t/filter/TestFilter/in_bbs_underrun.pm
@@ -56,7 +56,7 @@
use constant SIZE => 1024*16 + 5; # ~16k
sub handler {
- my($filter, $bb, $mode, $block, $readbytes) = @_;
+ my ($filter, $bb, $mode, $block, $readbytes) = @_;
my $ba = $filter->r->connection->bucket_alloc;
my $ctx = $filter->ctx;
my $buffer = defined $ctx ? $ctx : '';
diff --git a/t/filter/TestFilter/in_str_declined_read.pm b/t/filter/TestFilter/in_str_declined_read.pm
new file mode 100644
index 0000000..4ec3788
--- /dev/null
+++ b/t/filter/TestFilter/in_str_declined_read.pm
@@ -0,0 +1,51 @@
+package TestFilter::in_str_declined_read;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+
+use Apache2::Filter ();
+
+use TestCommon::Utils ();
+
+use Apache2::Const -compile => qw(OK DECLINED M_POST);
+
+# a filter must not return DECLINED after calling $r->read, since the
+# latter already fetches the bucket brigade in which case it's up to
+# the user to complete reading it and send it out
+# thefore this filter must fail
+sub handler {
+ my $filter = shift;
+
+ # this causes a fetch of bb
+ $filter->read(my $buffer, 10);
+
+ return Apache2::Const::DECLINED;
+}
+
+sub response {
+ my $r = shift;
+
+ plan $r, tests => 1;
+
+ $r->content_type('text/plain');
+
+ if ($r->method_number == Apache2::Const::M_POST) {
+ # this should fail, because of the failing filter
+ eval { TestCommon::Utils::read_post($r) };
+ ok $@;
+ }
+
+ Apache2::Const::OK;
+}
+1;
+__DATA__
+SetHandler modperl
+PerlModule TestFilter::in_str_declined_read
+PerlResponseHandler TestFilter::in_str_declined_read::response
+
diff --git a/t/filter/TestFilter/out_bbs_basic.pm b/t/filter/TestFilter/out_bbs_basic.pm
index 9481e66..fecd9b5 100644
--- a/t/filter/TestFilter/out_bbs_basic.pm
+++ b/t/filter/TestFilter/out_bbs_basic.pm
@@ -18,7 +18,7 @@
sub Apache::TestToString::PRINTF {}
sub handler {
- my($filter, $bb) = @_;
+ my ($filter, $bb) = @_;
unless ($filter->ctx) {
diff --git a/t/filter/TestFilter/out_bbs_ctx.pm b/t/filter/TestFilter/out_bbs_ctx.pm
index b014717..a3c3a48 100644
--- a/t/filter/TestFilter/out_bbs_ctx.pm
+++ b/t/filter/TestFilter/out_bbs_ctx.pm
@@ -23,7 +23,7 @@
use constant BLOCK_SIZE => 5003;
sub handler {
- my($filter, $bb) = @_;
+ my ($filter, $bb) = @_;
debug "filter got called";
diff --git a/t/filter/TestFilter/out_bbs_filebucket.pm b/t/filter/TestFilter/out_bbs_filebucket.pm
index 922ac9e..8c01a5f 100644
--- a/t/filter/TestFilter/out_bbs_filebucket.pm
+++ b/t/filter/TestFilter/out_bbs_filebucket.pm
@@ -21,7 +21,7 @@
use constant BLOCK_SIZE => 5003;
sub handler {
- my($filter, $bb) = @_;
+ my ($filter, $bb) = @_;
debug "FILTER INVOKED";
diff --git a/t/filter/TestFilter/out_str_buffer.pm b/t/filter/TestFilter/out_str_buffer.pm
index 13b2166..ce1c373 100644
--- a/t/filter/TestFilter/out_str_buffer.pm
+++ b/t/filter/TestFilter/out_str_buffer.pm
@@ -40,7 +40,7 @@
}
sub handler {
- my($filter, $bb) = @_;
+ my ($filter, $bb) = @_;
my $ctx = $filter->ctx;
@@ -52,7 +52,7 @@
my $data = exists $ctx->{data} ? $ctx->{data} : '';
$ctx->{invoked}++;
- my($bdata, $seen_eos) = flatten_bb($bb);
+ my ($bdata, $seen_eos) = flatten_bb($bb);
$bdata =~ s/-//g;
$data .= $bdata if $bdata;
diff --git a/t/filter/in_str_declined_read.t b/t/filter/in_str_declined_read.t
new file mode 100644
index 0000000..f92d4ec
--- /dev/null
+++ b/t/filter/in_str_declined_read.t
@@ -0,0 +1,11 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRequest 'POST_BODY_ASSERT';;
+
+my $location = '/TestFilter__in_str_declined_read';
+
+my $chunk = "1234567890";
+my $data = $chunk x 2000;
+
+print POST_BODY_ASSERT $location, content => $data;
diff --git a/t/filter/out_bbs_filebucket.t b/t/filter/out_bbs_filebucket.t
index a8ab54f..4419614 100644
--- a/t/filter/out_bbs_filebucket.t
+++ b/t/filter/out_bbs_filebucket.t
@@ -16,7 +16,7 @@
plan tests => 2 * scalar @sizes;
for my $size (@sizes) {
- my($file, $data) = write_file($size);
+ my ($file, $data) = write_file($size);
my $received = GET_BODY "$url?$file";
my $received_size = length $received;
diff --git a/t/filter/out_str_subreq_default.t b/t/filter/out_str_subreq_default.t
index 73b6225..fa78e68 100644
--- a/t/filter/out_str_subreq_default.t
+++ b/t/filter/out_str_subreq_default.t
@@ -17,8 +17,8 @@
my $expected = join '', $content1, $subrequest, $content2, $filter;
my $received = GET_BODY $location;
-# Win32 fix for line endings
-$received =~ s{\r}{}g if Apache::TestConfig::WIN32;
+# Win32 and Cygwin fix for line endings
+$received =~ s{\r}{}g if Apache::TestConfig::WIN32 || Apache::TestConfig::CYGWIN;
ok t_cmp($received, $expected,
"testing filter-originated lookup_uri() call to core served URI");
diff --git a/t/hooks/TestHooks/authen_basic.pm b/t/hooks/TestHooks/authen_basic.pm
index d559647..3ebc689 100644
--- a/t/hooks/TestHooks/authen_basic.pm
+++ b/t/hooks/TestHooks/authen_basic.pm
@@ -10,7 +10,7 @@
sub handler {
my $r = shift;
- my($rc, $sent_pw) = $r->get_basic_auth_pw;
+ my ($rc, $sent_pw) = $r->get_basic_auth_pw;
return $rc if $rc != Apache2::Const::OK;
diff --git a/t/hooks/TestHooks/authz.pm b/t/hooks/TestHooks/authz.pm
index 1cc62e5..a471b03 100644
--- a/t/hooks/TestHooks/authz.pm
+++ b/t/hooks/TestHooks/authz.pm
@@ -10,7 +10,7 @@
sub auth_any {
my $r = shift;
- my($res, $sent_pw) = $r->get_basic_auth_pw;
+ my ($res, $sent_pw) = $r->get_basic_auth_pw;
return $res if $res != Apache2::Const::OK;
unless($r->user and $sent_pw) {
@@ -30,7 +30,7 @@
return Apache2::Const::HTTP_UNAUTHORIZED unless $user;
- my($u, @allowed) = split /\s+/, $r->requires->[0]->{requirement};
+ my ($u, @allowed) = split /\s+/, $r->requires->[0]->{requirement};
return Apache2::Const::HTTP_UNAUTHORIZED unless grep { $_ eq $user } @allowed;
diff --git a/t/hooks/TestHooks/push_handlers_anon.pm b/t/hooks/TestHooks/push_handlers_anon.pm
index e02ce36..2f22ad9 100644
--- a/t/hooks/TestHooks/push_handlers_anon.pm
+++ b/t/hooks/TestHooks/push_handlers_anon.pm
@@ -50,7 +50,7 @@
use Apache::TestRequest;
Apache::TestRequest::module('TestHooks::push_handlers_anon');
my $hostport = Apache::TestRequest::hostport(Apache::Test::config());
- my($host, $port) = split ':', $hostport;
+ my ($host, $port) = split ':', $hostport;
my $s = Apache2::ServerUtil->server;
my $vs = $s->next;
for (; $vs; $vs = $vs->next) {
diff --git a/t/hooks/TestHooks/startup.pm b/t/hooks/TestHooks/startup.pm
index 8abc017..a765b4d 100644
--- a/t/hooks/TestHooks/startup.pm
+++ b/t/hooks/TestHooks/startup.pm
@@ -24,7 +24,7 @@
my $dir = catdir Apache::Test::vars("documentroot"), 'hooks', 'startup';
sub open_logs {
- my($conf_pool, $log_pool, $temp_pool, $s) = @_;
+ my ($conf_pool, $log_pool, $temp_pool, $s) = @_;
# main server
run("open_logs", $s);
@@ -41,7 +41,7 @@
}
sub post_config {
- my($conf_pool, $log_pool, $temp_pool, $s) = @_;
+ my ($conf_pool, $log_pool, $temp_pool, $s) = @_;
# main server
run("post_config", $s);
@@ -58,7 +58,7 @@
}
sub run {
- my($phase, $s) = @_;
+ my ($phase, $s) = @_;
my $val = $s->dir_config->{PostConfig} or die "Can't read PostConfig var";
diff --git a/t/hooks/hookrun.t b/t/hooks/hookrun.t
index 2677c6e..fcd0311 100644
--- a/t/hooks/hookrun.t
+++ b/t/hooks/hookrun.t
@@ -20,6 +20,6 @@
my $body = GET_BODY_ASSERT "http://$hostport/$path?normal";
for my $line (split /\n/, $body) {
- my($phase, $value) = split /:/, $line;
+ my ($phase, $value) = split /:/, $line;
ok t_cmp $value, 1, "$phase";
}
diff --git a/t/lib/TestAPRlib/string.pm b/t/lib/TestAPRlib/string.pm
index a7f7998..290fae5 100644
--- a/t/lib/TestAPRlib/string.pm
+++ b/t/lib/TestAPRlib/string.pm
@@ -24,7 +24,7 @@
sub test {
t_debug("size_string");
- while (my($k, $v) = each %size_string) {
+ while (my ($k, $v) = each %size_string) {
ok t_cmp($v, APR::String::format_size($k));
}
}
diff --git a/t/lib/TestAPRlib/table.pm b/t/lib/TestAPRlib/table.pm
index ef9a821..bf22325 100644
--- a/t/lib/TestAPRlib/table.pm
+++ b/t/lib/TestAPRlib/table.pm
@@ -213,7 +213,7 @@
$table->add("first" => 3);
my $i = 0;
- while (my($a,$b) = each %$table) {
+ while (my ($a,$b) = each %$table) {
my $key = ("first", "second")[$i % 2];
my $val = ++$i;
@@ -373,7 +373,7 @@
}
sub my_filter {
- my($key, $value) = @_;
+ my ($key, $value) = @_;
$filter_count++;
unless ($key eq chr($value+97)) {
die "arguments I received are bogus($key,$value)";
@@ -382,7 +382,7 @@
}
sub my_filter_stop {
- my($key, $value) = @_;
+ my ($key, $value) = @_;
$filter_count++;
unless ($key eq chr($value+97)) {
die "arguments I received are bogus($key,$value)";
diff --git a/t/lib/TestAPRlib/uri.pm b/t/lib/TestAPRlib/uri.pm
index 8170166..78aacf5 100644
--- a/t/lib/TestAPRlib/uri.pm
+++ b/t/lib/TestAPRlib/uri.pm
@@ -154,7 +154,7 @@
}
### port_of_scheme ###
- while (my($scheme, $port) = each %default_ports) {
+ while (my ($scheme, $port) = each %default_ports) {
my $apr_port = APR::URI::port_of_scheme($scheme);
ok t_cmp($apr_port, $port, "scheme: $scheme");
}
diff --git a/t/lib/TestAPRlib/util.pm b/t/lib/TestAPRlib/util.pm
index 35d56a2..e5b4c7e 100644
--- a/t/lib/TestAPRlib/util.pm
+++ b/t/lib/TestAPRlib/util.pm
@@ -34,7 +34,7 @@
{
ok ! APR::Util::password_validate("one", "two");
- while (my($mode, $hash) = each %hashes) {
+ while (my ($mode, $hash) = each %hashes) {
t_debug($mode);
if ($mode eq 'crypt' && !CRYPT_WORKS) {
t_debug("crypt is not supported on $^O");
diff --git a/t/lib/TestCommon/FilterDebug.pm b/t/lib/TestCommon/FilterDebug.pm
index c753b25..9856b51 100644
--- a/t/lib/TestCommon/FilterDebug.pm
+++ b/t/lib/TestCommon/FilterDebug.pm
@@ -24,7 +24,7 @@
sub snoop {
my $type = shift;
- my($filter, $bb, $mode, $block, $readbytes) = @_; # filter args
+ my ($filter, $bb, $mode, $block, $readbytes) = @_; # filter args
# $mode, $block, $readbytes are passed only for input filters
my $stream = defined $mode ? "input" : "output";
@@ -50,7 +50,7 @@
}
sub bb_dump {
- my($type, $stream, $bb) = @_;
+ my ($type, $stream, $bb) = @_;
my @data;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
@@ -69,7 +69,7 @@
}
my $c = 1;
- while (my($btype, $data) = splice @data, 0, 2) {
+ while (my ($btype, $data) = splice @data, 0, 2) {
print STDERR " o bucket $c: $btype\n";
print STDERR "[$data]\n";
$c++;
diff --git a/t/lib/TestCommon/SameInterp.pm b/t/lib/TestCommon/SameInterp.pm
index 22f9ed9..9e515db 100644
--- a/t/lib/TestCommon/SameInterp.pm
+++ b/t/lib/TestCommon/SameInterp.pm
@@ -31,7 +31,7 @@
skip "Skip couldn't find the same interpreter", 0;
}
else {
- my($package, $filename, $line) = caller;
+ my ($package, $filename, $line) = caller;
# trick ok() into reporting the caller filename/line when a
# sub-test fails in sok()
return eval <<EOE;
@@ -149,7 +149,7 @@
This wrapper is smart enough to report the correct line number as if
ok() was run in the test file itself and not in the wrapper, by doing:
- my($package, $filename, $line) = caller;
+ my ($package, $filename, $line) = caller;
return eval <<EOE;
#line $line $filename
ok &t_cmp;
diff --git a/t/lib/TestCommon/TiePerlSection.pm b/t/lib/TestCommon/TiePerlSection.pm
index 46e962a..27c94ab 100644
--- a/t/lib/TestCommon/TiePerlSection.pm
+++ b/t/lib/TestCommon/TiePerlSection.pm
@@ -11,7 +11,7 @@
use Tie::Hash;
our @ISA = qw(Tie::StdHash);
sub FETCH {
- my($hash, $key) = @_;
+ my ($hash, $key) = @_;
if ($key eq '/tied') {
return 'TIED';
}
diff --git a/t/lib/TestExit/FromPerlModule.pm b/t/lib/TestExit/FromPerlModule.pm
index b722e50..f609cb6 100644
--- a/t/lib/TestExit/FromPerlModule.pm
+++ b/t/lib/TestExit/FromPerlModule.pm
@@ -9,7 +9,7 @@
use Apache2::Const -compile => qw(OK);
sub exit_handler {
- my($p, $s) = @_;
+ my ($p, $s) = @_;
$s->log->info("Child process pid=$$ is exiting - server push");
diff --git a/t/modperl/setupenv2.t b/t/modperl/setupenv2.t
index 18be12f..877da97 100644
--- a/t/modperl/setupenv2.t
+++ b/t/modperl/setupenv2.t
@@ -17,7 +17,7 @@
plan tests => 2 + scalar(@{ $expected{mixed} }) + scalar(@{ $expected{perl} });
-while (my($k, $v) = each %expected) {
+while (my ($k, $v) = each %expected) {
my @expected = @$v;
my $elements = scalar @expected;
my $received = GET_BODY "$location?$k";
diff --git a/t/protocol/TestProtocol/eliza.pm b/t/protocol/TestProtocol/eliza.pm
index 7d5b03a..9200730 100644
--- a/t/protocol/TestProtocol/eliza.pm
+++ b/t/protocol/TestProtocol/eliza.pm
@@ -9,6 +9,7 @@
require Chatbot::Eliza;
use Apache2::Const -compile => 'OK';
+use APR::Const -compile => 'SO_NONBLOCK';
use constant BUFF_LEN => 1024;
diff --git a/t/protocol/TestProtocol/pseudo_http.pm b/t/protocol/TestProtocol/pseudo_http.pm
index 10548d8..713b06a 100644
--- a/t/protocol/TestProtocol/pseudo_http.pm
+++ b/t/protocol/TestProtocol/pseudo_http.pm
@@ -123,7 +123,7 @@
}
sub prompt {
- my($socket, $msg) = @_;
+ my ($socket, $msg) = @_;
$socket->send("$msg:\n");
getline($socket);
diff --git a/t/protocol/pseudo_http.t b/t/protocol/pseudo_http.t
index 461f097..187c9c5 100644
--- a/t/protocol/pseudo_http.t
+++ b/t/protocol/pseudo_http.t
@@ -55,13 +55,13 @@
}
sub expect {
- my($socket, $expect, $action) = @_;
+ my ($socket, $expect, $action) = @_;
chomp(my $recv = <$socket> || '');
ok t_cmp($recv, $expect, $action);
}
sub expect_reply {
- my($socket, $expect, $reply, $action) = @_;
+ my ($socket, $expect, $reply, $action) = @_;
chomp(my $recv = <$socket> || '');
ok t_cmp($recv, $expect, $action);
t_debug("send: $reply");
diff --git a/t/response/TestAPI/access2.pm b/t/response/TestAPI/access2.pm
index 0467fd1..45f9660 100644
--- a/t/response/TestAPI/access2.pm
+++ b/t/response/TestAPI/access2.pm
@@ -51,12 +51,12 @@
die "wanted satisfies=" . Apache2::Const::SATISFY_ALL . ", got $satisfies"
unless $r->satisfies() == Apache2::Const::SATISFY_ALL;
- my($rc, $sent_pw) = $r->get_basic_auth_pw;
+ my ($rc, $sent_pw) = $r->get_basic_auth_pw;
return $rc if $rc != Apache2::Const::OK;
# extract just the requirement entries
my %require =
- map { my($k, $v) = split /\s+/, $_->{requirement}, 2; ($k, $v||'') }
+ map { my ($k, $v) = split /\s+/, $_->{requirement}, 2; ($k, $v||'') }
@{ $r->requires };
debug \%require;
@@ -98,9 +98,7 @@
<IfModule @ACCESS_MODULE@>
# needed to test $r->satisfies
- Order Deny,Allow
- Deny from all
- Allow from @servername@
+ Allow from All
</IfModule>
AuthType Basic
AuthName "Access"
diff --git a/t/response/TestAPI/aplog.pm b/t/response/TestAPI/aplog.pm
index fcb22b3..f2a4e19 100644
--- a/t/response/TestAPI/aplog.pm
+++ b/t/response/TestAPI/aplog.pm
@@ -46,7 +46,7 @@
qr/... TestAPI::aplog test in progress/,
'$r->log->info';
- my($file, $line) = Apache2::Log::LOG_MARK;
+ my ($file, $line) = Apache2::Log::LOG_MARK;
ok $file eq __FILE__;
ok $line == __LINE__ - 2;
diff --git a/t/response/TestAPI/in_out_filters.pm b/t/response/TestAPI/in_out_filters.pm
index 5eb9c12..039fb58 100644
--- a/t/response/TestAPI/in_out_filters.pm
+++ b/t/response/TestAPI/in_out_filters.pm
@@ -34,7 +34,7 @@
}
sub send_response_body {
- my($r, $data) = @_;
+ my ($r, $data) = @_;
my $bb = APR::Brigade->new($r->pool,
$r->connection->bucket_alloc);
diff --git a/t/response/TestAPI/lookup_uri2.pm b/t/response/TestAPI/lookup_uri2.pm
index 4630f1c..31ab28d 100644
--- a/t/response/TestAPI/lookup_uri2.pm
+++ b/t/response/TestAPI/lookup_uri2.pm
@@ -28,7 +28,7 @@
}
sub subrequest {
- my($r, $sub) = @_;
+ my ($r, $sub) = @_;
(my $uri = join '::', __PACKAGE__, $sub) =~ s!::!__!g;
$r->lookup_uri($uri)->run;
}
diff --git a/t/response/TestAPI/request_util.pm b/t/response/TestAPI/request_util.pm
index 65a1757..2ee6a37 100644
--- a/t/response/TestAPI/request_util.pm
+++ b/t/response/TestAPI/request_util.pm
@@ -65,7 +65,7 @@
"test for the request_line, host, status, and few " .
"headers that should always be there");
- while (my($code, $line) = each %status_lines) {
+ while (my ($code, $line) = each %status_lines) {
ok t_cmp(Apache2::RequestUtil::get_status_line($code),
$line,
"Apache2::RequestUtil::get_status_line($code)");
diff --git a/t/response/TestAPI/status.pm b/t/response/TestAPI/status.pm
index c6d53f4..cad6ba9 100644
--- a/t/response/TestAPI/status.pm
+++ b/t/response/TestAPI/status.pm
@@ -17,7 +17,7 @@
$r->content_type('text/plain');
- my($code, $string) = split /=/, $r->args || '';
+ my ($code, $string) = split /=/, $r->args || '';
if ($string) {
$r->status(200); # status_line should override status
diff --git a/t/response/TestAPR/flatten.pm b/t/response/TestAPR/flatten.pm
index d406cbc..baa7023 100644
--- a/t/response/TestAPR/flatten.pm
+++ b/t/response/TestAPR/flatten.pm
@@ -99,7 +99,7 @@
# this sub runs 3 sub-tests with a false $check_content
# and 4 otherwise
sub verify {
- my($len, $expected_len, $data, $check_content) = @_;
+ my ($len, $expected_len, $data, $check_content) = @_;
ok t_cmp($len,
$expected_len,
diff --git a/t/response/TestAPR/perlio.pm b/t/response/TestAPR/perlio.pm
index 8633544..999a08f 100644
--- a/t/response/TestAPR/perlio.pm
+++ b/t/response/TestAPR/perlio.pm
@@ -344,7 +344,7 @@
}
sub count_chars {
- my($text, $chars) = @_;
+ my ($text, $chars) = @_;
my $seen = 0;
$seen++ while $text =~ /$chars/g;
return $seen;
diff --git a/t/response/TestApache/subprocess.pm b/t/response/TestApache/subprocess.pm
index 3d50e71..70e1dc8 100644
--- a/t/response/TestApache/subprocess.pm
+++ b/t/response/TestApache/subprocess.pm
@@ -31,7 +31,7 @@
my $target_dir = catdir $vars->{documentroot}, "util";
- while (my($file, $code) = each %scripts) {
+ while (my ($file, $code) = each %scripts) {
$file = catfile $target_dir, "$file.pl";
$self->write_perlscript($file, "$code\n");
}
@@ -138,7 +138,7 @@
sub read_data {
- my($fh) = @_;
+ my ($fh) = @_;
my @data = ();
my $sel = IO::Select->new($fh);
diff --git a/t/response/TestApache/util.pm b/t/response/TestApache/util.pm
index aa89746..676cce0 100644
--- a/t/response/TestApache/util.pm
+++ b/t/response/TestApache/util.pm
@@ -65,7 +65,7 @@
# escape_path
{
- my($uri, $received, $expected);
+ my ($uri, $received, $expected);
$uri = "a 'long' file?.html";
($expected = $uri) =~ s/([\s?;])/sprintf "%%%x", ord $1/ge;
@@ -98,7 +98,7 @@
my $fmtdate_re = qr/^\w+, \d\d \w+ \d\d\d\d \d\d:\d\d:\d\d/;
sub time_cmp {
- my($fmtdate, $time, $comment, $exact_match) = @_;
+ my ($fmtdate, $time, $comment, $exact_match) = @_;
if ($parse_time_ok && $exact_match) {
my $ptime = APR::Date::parse_http($fmtdate);
diff --git a/t/response/TestCompat/apache_module.pm b/t/response/TestCompat/apache_module.pm
index 6795f24..5894867 100644
--- a/t/response/TestCompat/apache_module.pm
+++ b/t/response/TestCompat/apache_module.pm
@@ -20,13 +20,13 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub TestCompatApacheModuleParms {
- my($self, $parms, $args) = @_;
+ my ($self, $parms, $args) = @_;
my $config = Apache2::Module->get_config($self, $parms->server);
$config->{data} = $args;
}
sub handler : method {
- my($self, $r) = @_;
+ my ($self, $r) = @_;
plan $r, tests => 2;
diff --git a/t/response/TestCompat/apache_util.pm b/t/response/TestCompat/apache_util.pm
index c7890af..dfd18a3 100644
--- a/t/response/TestCompat/apache_util.pm
+++ b/t/response/TestCompat/apache_util.pm
@@ -42,7 +42,7 @@
# size_string()
{
- while (my($k, $v) = each %string_size) {
+ while (my ($k, $v) = each %string_size) {
ok t_cmp($v, Apache::Util::size_string($k));
}
}
diff --git a/t/response/TestCompat/conn_authen.pm b/t/response/TestCompat/conn_authen.pm
index 07c9b39..becb033 100644
--- a/t/response/TestCompat/conn_authen.pm
+++ b/t/response/TestCompat/conn_authen.pm
@@ -25,7 +25,7 @@
if $req_auth_type;
# get_basic_auth_pw populates $r->user and $r->ap_auth_type
- my($rc, $sent_pw) = $r->get_basic_auth_pw;
+ my ($rc, $sent_pw) = $r->get_basic_auth_pw;
return $rc if $rc != Apache2::Const::OK;
diff --git a/t/response/TestDirective/cmdparms.pm b/t/response/TestDirective/cmdparms.pm
index c36d412..583e8de 100644
--- a/t/response/TestDirective/cmdparms.pm
+++ b/t/response/TestDirective/cmdparms.pm
@@ -41,7 +41,7 @@
pool server temp_pool);
sub TestCmdParms {
- my($self, $parms, $args) = @_;
+ my ($self, $parms, $args) = @_;
my $srv_cfg = $self->get_config($parms->server);
foreach my $method (@methods) {
$srv_cfg->{$args}{$method} = $parms->$method();
@@ -54,7 +54,7 @@
sub handler : method {
- my($self, $r) = @_;
+ my ($self, $r) = @_;
plan $r, tests => 1;
diff --git a/t/response/TestDirective/env.pm b/t/response/TestDirective/env.pm
index 631c373..e070f0e 100644
--- a/t/response/TestDirective/env.pm
+++ b/t/response/TestDirective/env.pm
@@ -56,7 +56,7 @@
}
sub env_get {
- my($name, $r) = @_;
+ my ($name, $r) = @_;
my $key = 'TestDirective__env_' . $name;
my $value = $ENV{$key};
diff --git a/t/response/TestDirective/perlloadmodule.pm b/t/response/TestDirective/perlloadmodule.pm
index fffc9ec..e88980a 100644
--- a/t/response/TestDirective/perlloadmodule.pm
+++ b/t/response/TestDirective/perlloadmodule.pm
@@ -35,7 +35,7 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub DIR_CREATE {
- my($class, $parms) = @_;
+ my ($class, $parms) = @_;
bless {
path => $parms->path || "/",
@@ -43,7 +43,7 @@
}
sub merge {
- my($base, $add) = @_;
+ my ($base, $add) = @_;
my %new = ();
@@ -66,7 +66,7 @@
#}
sub SERVER_CREATE {
- my($class, $parms) = @_;
+ my ($class, $parms) = @_;
debug "$class->SERVER_CREATE\n";
return bless {
name => __PACKAGE__,
@@ -74,30 +74,30 @@
}
sub MyTest {
- my($self, $parms, @args) = @_;
+ my ($self, $parms, @args) = @_;
$self->{MyTest} = \@args;
$self->{MyTestInfo} = $parms->info;
}
sub MyOtherTest {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{MyOtherTest} = $arg;
$self->{MyOtherTestInfo} = $parms->info;
}
sub ServerTest {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
my $srv_cfg = $self->get_config($parms->server);
$srv_cfg->{ServerTest} = $arg;
}
sub get_config {
- my($self, $s) = (shift, shift);
+ my ($self, $s) = (shift, shift);
Apache2::Module::get_config($self, $s, @_);
}
sub handler : method {
- my($self, $r) = @_;
+ my ($self, $r) = @_;
my $s = $r->server;
my $dir_cfg = $self->get_config($s, $r->per_dir_config);
diff --git a/t/response/TestDirective/perlloadmodule2.pm b/t/response/TestDirective/perlloadmodule2.pm
index 5b50bc9..7c24be3 100644
--- a/t/response/TestDirective/perlloadmodule2.pm
+++ b/t/response/TestDirective/perlloadmodule2.pm
@@ -24,7 +24,7 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub merge {
- my($base, $add) = @_;
+ my ($base, $add) = @_;
my %new = ();
@@ -56,7 +56,7 @@
# only during the server startup and when the directive appears in the
# .htaccess files
sub MyMergeTest {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
#warn "MyMergeTest: @{[$parms->path||'']}\n\t$arg\n";
push @{ $self->{MyMergeTest} }, $arg;
@@ -71,12 +71,12 @@
}
sub get_config {
- my($self, $s) = (shift, shift);
+ my ($self, $s) = (shift, shift);
Apache2::Module::get_config($self, $s, @_);
}
sub handler : method {
- my($self, $r) = @_;
+ my ($self, $r) = @_;
$r->content_type('text/plain');
diff --git a/t/response/TestDirective/perlloadmodule3.pm b/t/response/TestDirective/perlloadmodule3.pm
index 891c210..d1baa38 100644
--- a/t/response/TestDirective/perlloadmodule3.pm
+++ b/t/response/TestDirective/perlloadmodule3.pm
@@ -34,7 +34,7 @@
sub SERVER_MERGE { merge(@_) }
sub set_val {
- my($key, $self, $parms, $arg) = @_;
+ my ($key, $self, $parms, $arg) = @_;
$self->{$key} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
@@ -43,7 +43,7 @@
}
sub push_val {
- my($key, $self, $parms, $arg) = @_;
+ my ($key, $self, $parms, $arg) = @_;
push @{ $self->{$key} }, $arg;
unless ($parms->path) {
my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
@@ -52,7 +52,7 @@
}
sub merge {
- my($base, $add) = @_;
+ my ($base, $add) = @_;
my %mrg = ();
for my $key (keys %$base, %$add) {
@@ -93,7 +93,7 @@
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my %secs = ();
$r->content_type('text/plain');
diff --git a/t/response/TestDirective/perlloadmodule4.pm b/t/response/TestDirective/perlloadmodule4.pm
index 859b09f..b471800 100644
--- a/t/response/TestDirective/perlloadmodule4.pm
+++ b/t/response/TestDirective/perlloadmodule4.pm
@@ -31,7 +31,7 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub MyTest4 {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
@@ -57,7 +57,7 @@
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my %secs = ();
$r->content_type('text/plain');
diff --git a/t/response/TestDirective/perlloadmodule5.pm b/t/response/TestDirective/perlloadmodule5.pm
index 4896d66..05f4ed6 100644
--- a/t/response/TestDirective/perlloadmodule5.pm
+++ b/t/response/TestDirective/perlloadmodule5.pm
@@ -29,7 +29,7 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub MyTest5 {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
@@ -54,7 +54,7 @@
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my %secs = ();
$r->content_type('text/plain');
diff --git a/t/response/TestDirective/perlloadmodule6.pm b/t/response/TestDirective/perlloadmodule6.pm
index 1b63995..14d544a 100644
--- a/t/response/TestDirective/perlloadmodule6.pm
+++ b/t/response/TestDirective/perlloadmodule6.pm
@@ -19,7 +19,7 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub MyTest6 {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
@@ -44,7 +44,7 @@
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my %secs = ();
$r->content_type('text/plain');
diff --git a/t/response/TestDirective/perlloadmodule7.pm b/t/response/TestDirective/perlloadmodule7.pm
index 04880ea..b589487 100644
--- a/t/response/TestDirective/perlloadmodule7.pm
+++ b/t/response/TestDirective/perlloadmodule7.pm
@@ -22,12 +22,12 @@
Apache2::Module::add(__PACKAGE__, \@directives);
sub MyTest7_1 {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{+KEY1} = $arg;
}
sub MyTest7_2 {
- my($self, $parms, $arg) = @_;
+ my ($self, $parms, $arg) = @_;
$self->{+KEY2} = $arg;
}
@@ -42,7 +42,7 @@
use Apache2::Const -compile => qw(OK);
sub handler {
- my($r) = @_;
+ my ($r) = @_;
plan $r, tests => 1;
diff --git a/t/response/TestDirective/perlrequire.pm b/t/response/TestDirective/perlrequire.pm
index 2c25f3f..24a5efc 100644
--- a/t/response/TestDirective/perlrequire.pm
+++ b/t/response/TestDirective/perlrequire.pm
@@ -40,7 +40,7 @@
# create two different PerlRequireTest.pm packages to be loaded by
# vh and main interpreters, on the fly before the tests start
- while (my($test, $magic) = each %require_tests) {
+ while (my ($test, $magic) = each %require_tests) {
my $content = <<EOF;
package ApacheTest::PerlRequireTest;
\$ApacheTest::PerlRequireTest::MAGIC = '$magic';
diff --git a/t/response/TestDirective/setupenv.pm b/t/response/TestDirective/setupenv.pm
index 1344b8c..f6a1703 100644
--- a/t/response/TestDirective/setupenv.pm
+++ b/t/response/TestDirective/setupenv.pm
@@ -13,7 +13,7 @@
$ENV{QS} = $r->args if $r->args;
- while (my($key, $val) = each %ENV) {
+ while (my ($key, $val) = each %ENV) {
next unless $key and $val;
$r->puts("$key=$val\n");
}
diff --git a/t/response/TestError/runtime.pm b/t/response/TestError/runtime.pm
index 448dbc7..c56a47e 100644
--- a/t/response/TestError/runtime.pm
+++ b/t/response/TestError/runtime.pm
@@ -34,7 +34,7 @@
}
sub overload_test {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
eval { mp_error($socket) };
@@ -57,47 +57,47 @@
}
sub plain_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
t_server_log_error_is_expected();
mp_error($socket);
}
sub plain_non_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
t_server_log_error_is_expected();
non_mp_error($socket);
}
sub die_hook_confess_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
local $SIG{__DIE__} = \&APR::Error::confess;
t_server_log_error_is_expected();
mp_error($socket);
}
sub die_hook_confess_non_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
local $SIG{__DIE__} = \&APR::Error::confess;
t_server_log_error_is_expected();
non_mp_error($socket);
}
sub die_hook_custom_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
local $SIG{__DIE__} = sub { die "custom die hook: $_[0]" };
t_server_log_error_is_expected();
mp_error($socket);
}
sub die_hook_custom_non_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
local $SIG{__DIE__} = sub { die "custom die hook: $_[0]" };
t_server_log_error_is_expected();
non_mp_error($socket);
}
sub eval_block_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
# throw in some retry attempts
my $tries = 0;
@@ -116,7 +116,7 @@
}
sub eval_string_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
eval '$socket->recv(my $buffer, SIZE)';
if ($@ && ref($@) && APR::Status::is_EAGAIN($@)) {
$r->print("ok eval_string_mp_error");
@@ -127,7 +127,7 @@
}
sub eval_block_non_mp_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
eval { non_mp_error($socket) };
if ($@ && !ref($@)) {
$r->print("ok eval_block_non_mp_error");
@@ -138,7 +138,7 @@
}
sub eval_block_non_error {
- my($r, $socket) = @_;
+ my ($r, $socket) = @_;
eval { 1; };
if ($@) {
die "eval eval_block_non_mp_error has failed";
diff --git a/t/response/TestModperl/cookie.pm b/t/response/TestModperl/cookie.pm
index 9faab55..6da8421 100644
--- a/t/response/TestModperl/cookie.pm
+++ b/t/response/TestModperl/cookie.pm
@@ -16,7 +16,7 @@
# setup CGI variables early
$r->subprocess_env() if $r->args eq 'env';
- my($key, $val) = cookie($r);
+ my ($key, $val) = cookie($r);
my $cookie_is_expected =
($r->args eq 'header' or $r->args eq 'env') ? 1 : 0;
die "Can't get the cookie" if $cookie_is_expected && !defined $val;
@@ -27,7 +27,7 @@
sub handler {
my $r = shift;
- my($key, $val) = cookie($r);
+ my ($key, $val) = cookie($r);
$r->print($val) if defined $val;
return Apache2::Const::OK;
diff --git a/t/response/TestModperl/cookie2.pm b/t/response/TestModperl/cookie2.pm
index 24f0479..18c56e0 100644
--- a/t/response/TestModperl/cookie2.pm
+++ b/t/response/TestModperl/cookie2.pm
@@ -14,7 +14,7 @@
my $r = shift;
$r->subprocess_env if $r->args eq 'subprocess_env';
- my($key, $val) = cookie($r);
+ my ($key, $val) = cookie($r);
die "I shouldn't get the cookie" if $r->args eq 'env' && defined $val;
return Apache2::Const::OK;
@@ -23,7 +23,7 @@
sub handler {
my $r = shift;
- my($key, $val) = cookie($r);
+ my ($key, $val) = cookie($r);
$r->print($val) if defined $val;
return Apache2::Const::OK;
diff --git a/t/response/TestModperl/method.pm b/t/response/TestModperl/method.pm
index 8b4b3c0..bcd38a8 100644
--- a/t/response/TestModperl/method.pm
+++ b/t/response/TestModperl/method.pm
@@ -18,7 +18,7 @@
}
sub handler : method {
- my($self, $r) = @_;
+ my ($self, $r) = @_;
my $tests = 3;
diff --git a/t/response/TestModperl/setupenv2.pm b/t/response/TestModperl/setupenv2.pm
index 90803aa..a3bb46a 100644
--- a/t/response/TestModperl/setupenv2.pm
+++ b/t/response/TestModperl/setupenv2.pm
@@ -45,12 +45,12 @@
}
sub get_config {
- my($self, $s) = (shift, shift);
+ my ($self, $s) = (shift, shift);
Apache2::Module::get_config($self, $s, @_);
}
sub handler {
- my($r) = @_;
+ my ($r) = @_;
my $args = $r->args || '';
diff --git a/t/response/TestModperl/subenv.pm b/t/response/TestModperl/subenv.pm
index 4548f7b..e604d27 100644
--- a/t/response/TestModperl/subenv.pm
+++ b/t/response/TestModperl/subenv.pm
@@ -94,7 +94,7 @@
}
sub ok_true {
- my($r, $key) = @_;
+ my ($r, $key) = @_;
my $env = $r->subprocess_env;
ok $env->get($key);
@@ -103,7 +103,7 @@
}
sub ok_false {
- my($r, $key) = @_;
+ my ($r, $key) = @_;
my $env = $r->subprocess_env;
ok ! $env->get($key);
diff --git a/todo/apache2_rename b/todo/apache2_rename
deleted file mode 100644
index 3583d38..0000000
--- a/todo/apache2_rename
+++ /dev/null
@@ -1,31 +0,0 @@
-This file tracks the current status
-of the apache2-rename-unstable branch.
-
-The general goals for this branch are:
-
- - remove Apache2.pm, withdrawing support for MP_INST_APACHE2.
- - rename all Apache::Foo -> Apache2::Foo,
- including mod_perl -> mod_perl2
- - update Apache-Test.
- - update the 2.0 documentation.
- - merge with trunk, and resume the candidate process.
-
-This is an unstable branch, because the renaming
-process will impact all aspects of the codebase.
-The first set of code commits towards the actual renaming
-are expected to break the build system; so we'll need to
-mark a few milestones to prepare for the trunk merge.
-joes suggests these, s/TODO/DONE/ as each one is achieved:
-
-
-DONE: rename the modules, and bring the build
- system back to a compilable state. This
- effort will leave all of the tests broken.
-
-DONE: correct Apache-Test and the mp2 test suite,
- so all tests pass again.
-
-TODO: remove Apache2.pm and MP_INST_APACHE2.
- This effort should not yield any test regressions.
-
-TODO: port the 2.0 documentation.
diff --git a/todo/bugs_build b/todo/bugs_build
index 597d818..e2c5754 100644
--- a/todo/bugs_build
+++ b/todo/bugs_build
@@ -28,14 +28,15 @@
but doesn't start with worker:
http://marc.theaimsgroup.com/?t=106894906200003&r=1&w=2
-FreeBSD ?? DSO Works with non-threaded perl (4.8-RELEASE and
- 5.1-RELEASE)
+FreeBSD ?? DSO Works with non-threaded perl (4.8-RELEASE-5.2-RELEASE, 6.0-CURRENT)
http://marc.theaimsgroup.com/?l=apache-modperl&m=106399870822612&w=2
- It doesn't work with threaded perl/worker mpm,
- seemingly because of the problems with threads on
- FreeBSD (not sure what version). But reported to work
- on FreeBSD 5.3+ when linked with libpthread and not
- the older libc_r library.
+ The following combo is known to work:
+ http://gossamer-threads.com/lists/modperl/modperl/82887
+ FreeBSD 5.4-RELEASE
+ gcc 3.4.2
+ perl 5.8.7 WITH ithreads
+ httpd 2.0.54 apr IS THREADED (worker mpm)
+ mod_perl2.0.1
HPUX11i DSO
PA-RISC2.0-thread-multi-LP64
@@ -64,19 +65,12 @@
xs/modperl_xs*.h, when the latter change 'make' won't rebuild the
dependant files
-* gcc 3.3 (from cvs 2003-07-28) supports a new option:
- -Wdeclaration-after-statement, which we need to enable in the
- maintainer mode, to catch any declarations after statements, since
- by default gcc doesn't complain about them. Probably need to wait
- till gcc-3.3.2 and enable it then.
- http://gcc.gnu.org/cgi-bin/cvsweb.cgi/gcc/gcc/ChangeLog.diff?r1=2.639&r2=2.640&f=h
-
-
* Testing:
Need to put Philippe's smoking test into the core
-- shouldn't forget to test with perlio enabled and disabled
* mp2bug -- add the output of 'ldd httpd' to the report
+[pgollucci volunteers]
* source_scan won't create Wrap/Foo/Bar.xs if
xs/maps/modperl_functions.map defines only a boot section:
diff --git a/todo/release b/todo/release
index 11ad7b5..a88bada 100644
--- a/todo/release
+++ b/todo/release
@@ -9,6 +9,23 @@
-------------
+The following items need more work in order to work with blead-perl:
+
+http://svn.apache.org/viewcvs?rev=209859&view=rev
+perl blead fix: in 5.9.3 HvPMROOT was completely removed, temporary
+using Perl_Imodglobal_ptr(thx)))->xmg_magic (which fails on perl_clone
+from ithreads, but otherwise works). this must be replaced with a
+better solution once we find it.
+
+http://svn.apache.org/viewcvs?rev=209861&view=rev
+blead perl temp fix: some recent change introduced tainting problems,
+will remove the workaround once blead perl is fixed
+
+
+
+
+-------------
+
MP_STATIC_EXTS=1 must link all extensions but APR.so. At the moment
the following are not linked:
diff --git a/xs/APR/APR/Makefile.PL b/xs/APR/APR/Makefile.PL
index 06b1a5a..b37efec 100644
--- a/xs/APR/APR/Makefile.PL
+++ b/xs/APR/APR/Makefile.PL
@@ -9,6 +9,7 @@
use File::Spec::Functions;
use constant WIN32 => Apache2::Build::WIN32;
+use constant CYGWIN => Apache2::Build::CYGWIN;
use constant SOLARIS => $^O eq 'solaris';
use constant BUILD_APREXT => Apache2::Build::BUILD_APREXT;
@@ -30,7 +31,13 @@
if (BUILD_APREXT) {
my $mp_apr_lib = $build->mp_apr_lib;
- $libs .= qq{ $mp_apr_lib };
+
+ if (CYGWIN) {
+ # For Cygwin compatibility, set $mp_apr_lib before the apru flags
+ $libs = qq{ $mp_apr_lib } . $libs;
+ } else {
+ $libs .= qq{ $mp_apr_lib };
+ }
}
if (SOLARIS && $libs) {
diff --git a/xs/APR/Base64/APR__Base64.h b/xs/APR/Base64/APR__Base64.h
index f16a516..a41003e 100644
--- a/xs/APR/Base64/APR__Base64.h
+++ b/xs/APR/Base64/APR__Base64.h
@@ -15,13 +15,13 @@
/* apr_base64_encode_len and apr_base64_encode_binary give length that
* includes the terminating '\0' */
-#define mpxs_APR__Base64_encode_len(len) apr_base64_encode_len(len) - 1;
+#define mpxs_APR__Base64_encode_len(len) (apr_base64_encode_len(len) - 1)
static MP_INLINE void mpxs_apr_base64_encode(pTHX_ SV *sv, SV *arg)
{
STRLEN len;
int encoded_len;
- char *data = SvPV(arg, len);
+ unsigned char *data = (unsigned char *)SvPV(arg, len);
mpxs_sv_grow(sv, apr_base64_encode_len(len) - 1);
encoded_len = apr_base64_encode_binary(SvPVX(sv), data, len);
mpxs_sv_cur_set(sv, encoded_len - 1);
@@ -33,7 +33,7 @@
int decoded_len;
char *data = SvPV(arg, len);
mpxs_sv_grow(sv, apr_base64_decode_len(data));
- decoded_len = apr_base64_decode_binary(SvPVX(sv), data);
+ decoded_len = apr_base64_decode_binary((unsigned char *)SvPVX(sv), data);
mpxs_sv_cur_set(sv, decoded_len);
}
