cvs commit: modperl-2.0/ModPerl-Registry/t basic.t
stas01/10/19 00:32:31
Modified:ModPerl-Registry/t basic.t
Log:
- improve debug's verbosity
Revision ChangesPath
1.3 +21 -14modperl-2.0/ModPerl-Registry/t/basic.t
Index: basic.t
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/basic.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- basic.t 2001/10/17 05:34:38 1.2
+++ basic.t 2001/10/19 07:32:31 1.3
@@ -5,55 +5,62 @@
use Apache::TestUtil;
use Apache::TestRequest;
-my @modules = qw(registry registry_ng registry_bb perlrun);
+my %modules =
+(registry=> 'ModPerl::Registry',
+ registry_ng => 'ModPerl::RegistryNG',
+ registry_bb => 'ModPerl::RegistryBB',
+ perlrun => 'ModPerl::PerlRun',
+);
-plan tests => scalar @modules * 3;
+my @aliases = sort keys %modules;
+plan tests => @aliases * 3;
+
my $cfg = Apache::Test::config();
# very basic compilation/response test
-for my $module (@modules) {
-my $url = "/$module/basic.pl";
+for my $alias (@aliases) {
+my $url = "/$alias/basic.pl";
ok t_cmp(
"ok",
$cfg->http_raw_get($url),
- "basic cgi test",
+ "$modules{$alias} basic cgi test",
);
}
# test non-executable bit
-for my $module (@modules) {
-my $url = "/$module/not_executable.pl";
+for my $alias (@aliases) {
+my $url = "/$alias/not_executable.pl";
ok t_cmp(
"403 Forbidden",
HEAD($url)->status_line(),
- "non-executable file",
+ "$modules{$alias} non-executable file",
);
}
# test environment pre-set
-for my $module (@modules) {
-my $url = "/$module/env.pl?foo=bar";
+for my $alias (@aliases) {
+my $url = "/$alias/env.pl?foo=bar";
ok t_cmp(
"foo=bar",
$cfg->http_raw_get($url),
- "mod_cgi-like environment pre-set",
+ "$modules{$alias} mod_cgi-like environment pre-set",
);
}
# chdir is not safe yet!
#
# require (actually chdir test)
-#for my $module (@modules) {
-#my $url = "/$module/require.pl";
+#for my $alias (@aliases) {
+#my $url = "/$alias/require.pl";
#ok t_cmp(
# "it works",
# $cfg->http_raw_get($url),
-# "mod_cgi-like environment pre-set",
+# "$modules{$alias} mod_cgi-like environment pre-set",
#);
#}
cvs commit: modperl-2.0/ModPerl-Registry/lib/ModPerl RegistryCooker.pm
stas01/10/19 00:35:26
Modified:ModPerl-Registry/lib/ModPerl RegistryCooker.pm
Log:
- add uncache_myself func used in the tests, to cause the registry module
forget that it has a script cached
- use the implement by mod_perl BEGIN/END blocks execution as it was in
1.x
Revision ChangesPath
1.3 +36 -6 modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
Index: RegistryCooker.pm
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- RegistryCooker.pm 2001/10/17 05:35:34 1.2
+++ RegistryCooker.pm 2001/10/19 07:35:26 1.3
@@ -16,16 +16,16 @@
our $VERSION = '1.99';
use Apache::compat ();
-# Should not use Apache::compat, the following methods need to be implemented
+# META: Should not use Apache::compat, the following methods need to
+# be implemented:
# $r->slurp_filename
-# $r->clear_rgy_endav
-# $r->stash_rgy_endav
use Apache::Response;
use Apache::Log;
use Apache::Const -compile => qw(:common &OPT_EXECCGI);
use File::Spec::Functions ();
use ModPerl::Util ();
+use ModPerl::Global ();
#
# issues
@@ -214,6 +214,7 @@
no warnings;
eval { $rc = &{$cv}($r, @_) } if $r->seqno;
$o->[STATUS] = $rc;
+ModPerl::Global::special_list_call(END => $package);
}
$o->flush_namespace;
@@ -420,10 +421,39 @@
sub cache_it {
my $o = shift;
no strict 'refs';
-${$o->[CLASS]}->{ $o->[PACKAGE] }{mtime} = $o->[MTIME];
+${ $o->[CLASS] }->{ $o->[PACKAGE] }{mtime} = $o->[MTIME];
}
#
+# func: uncache_myself
+# dflt: uncache_myself
+# desc: unmark the package as cached by forgetting its modification time
+# args: none
+# rtrn: nothing
+# note: this is a function and not a method, it should be called from
+# the registry script, and using the caller() method we figure
+# out the package the script was compiled into
+
+#
+
+sub uncache_myself {
+my $package = scalar caller;
+# guess the registry class from the first two package segments
+# XXX: this will break if someone creates a registry class which
+# is not X::Y, but this function was written for the tests.
+my($class) = $package =~ /([^:]+::[^:]+)/;
+warn "cannot figure out class name from $package",
+return unless defined $class;
+no strict 'refs';
+if (exists ${$class}->{$package} && exists ${$class}->{$package}{mtime}) {
+delete ${$class}->{$package}{mtime};
+}
+else {
+warn "cannot find ${class}->{$package}{mtime}";
+}
+}
+
+#
# func: is_cached
# dflt: is_cached
# desc: checks whether the package is already cached
@@ -651,8 +681,9 @@
my $r = $o->[REQ];
$o->debug("compiling $o->[FILENAME]") if DEBUG && D_COMPILE;
+
+ModPerl::Global::special_list_clear(END => $o->[PACKAGE]);
-$r->clear_rgy_endav;
ModPerl::Util::untaint($$eval);
{
# let the code define its own warn and strict level
@@ -661,7 +692,6 @@
eval $$eval;
}
-$r->stash_rgy_endav;
return $o->error_check;
}
cvs commit: modperl-2.0/ModPerl-Registry/t special_blocks.t
stas01/10/19 00:36:13
Added: ModPerl-Registry/t special_blocks.t
Log:
- test how registry modules handle BEGIN/END blocks
Revision ChangesPath
1.1 modperl-2.0/ModPerl-Registry/t/special_blocks.t
Index: special_blocks.t
===
use strict;
use warnings FATAL => 'all';
# test BEGIN/END blocks's behavior
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
my %modules = (
registry=> 'ModPerl::Registry',
registry_ng => 'ModPerl::RegistryNG',
registry_bb => 'ModPerl::RegistryBB',
perlrun => 'ModPerl::PerlRun',
);
my @aliases = sort keys %modules;
plan tests => @aliases * 4;
{
# PerlRun always run BEGIN/END since it's never cached
my $alias = "perlrun";
my $url = "/same_interp/$alias/blocks.pl";
my $same_interp = Apache::TestRequest::same_interp_tie($url);
ok t_cmp(
"begin ok",
req($same_interp, "$url?test=begin"),
"$modules{$alias} is running BEGIN blocks on the first req",
);
ok t_cmp(
"begin ok",
req($same_interp, "$url?test=begin"),
"$modules{$alias} is running BEGIN blocks on the second req",
);
ok t_cmp(
"end ok",
req($same_interp, "$url?test=end"),
"$modules{$alias} is running END blocks on the first req",
);
ok t_cmp(
"end ok",
req($same_interp, "$url?test=end"),
"$modules{$alias} is running END blocks on the second req",
);
}
# To properly test BEGIN/END blocks in registry implmentations
# that do caching, we need to manually reset the registry* cache
# for each given script, before starting each group of tests.
for my $alias (grep !/^perlrun$/, @aliases) {
my $url = "/same_interp/$alias/blocks.pl";
my $same_interp = Apache::TestRequest::same_interp_tie($url);
# clear the cache of the registry package for the script in $url
req($same_interp, "$url?test=uncache");
ok t_cmp(
"begin ok",
req($same_interp, "$url?test=begin"),
"$modules{$alias} is running BEGIN blocks on the first req",
);
ok t_cmp(
"",
req($same_interp, "$url?test=begin"),
"$modules{$alias} is not running BEGIN blocks on the second req",
);
# clear the cache of the registry package for the script in $url
req($same_interp, "$url?test=uncache");
ok t_cmp(
"end ok",
req($same_interp, "$url?test=end"),
"$modules{$alias} is running END blocks on the first req",
);
ok t_cmp(
"end ok",
req($same_interp, "$url?test=end"),
"$modules{$alias} is running END blocks on the second req",
);
}
sub req {
my($same_interp, $url) = @_;
my $res = Apache::TestRequest::same_interp_do($same_interp,
\&GET, $url);
return $res ? $res->content : undef;
}
cvs commit: modperl-2.0/src/modules/perl modperl_handler.h modperl_perl_global.h modperl_types.h
dougm 01/10/19 09:40:45
Modified:src/modules/perl modperl_handler.h modperl_perl_global.h
modperl_types.h
Log:
get rid of hpux warnings:
Dangling comma not allowed by ANSI standard, ignored.
Revision ChangesPath
1.8 +1 -1 modperl-2.0/src/modules/perl/modperl_handler.h
Index: modperl_handler.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_handler.h 2001/04/19 17:57:15 1.7
+++ modperl_handler.h 2001/10/19 16:40:44 1.8
@@ -4,7 +4,7 @@
typedef enum {
MP_HANDLER_ACTION_GET,
MP_HANDLER_ACTION_PUSH,
-MP_HANDLER_ACTION_SET,
+MP_HANDLER_ACTION_SET
} modperl_handler_action_e;
#define modperl_handler_array_new(p) \
1.10 +1 -1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_perl_global.h 2001/10/13 19:02:03 1.9
+++ modperl_perl_global.h 2001/10/19 16:40:44 1.10
@@ -9,7 +9,7 @@
} modperl_modglobal_key_t;
typedef enum {
-MP_MODGLOBAL_END,
+MP_MODGLOBAL_END
} modperl_modglobal_key_e;
typedef struct {
1.52 +2 -2 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- modperl_types.h 2001/09/28 19:51:40 1.51
+++ modperl_types.h 2001/10/19 16:40:44 1.52
@@ -107,7 +107,7 @@
MP_INTERP_SCOPE_HANDLER,
MP_INTERP_SCOPE_SUBREQUEST,
MP_INTERP_SCOPE_REQUEST,
-MP_INTERP_SCOPE_CONNECTION,
+MP_INTERP_SCOPE_CONNECTION
} modperl_interp_scope_e;
typedef struct {
@@ -176,7 +176,7 @@
typedef enum {
MP_INPUT_FILTER_MODE,
-MP_OUTPUT_FILTER_MODE,
+MP_OUTPUT_FILTER_MODE
} modperl_filter_mode_e;
typedef struct {
cvs commit: modperl-2.0/ModPerl-Registry/lib/ModPerl RegistryCooker.pm
stas01/10/19 03:37:20
Modified:ModPerl-Registry/lib/ModPerl RegistryCooker.pm
Log:
- module cleanup, moving XXX/META's into the todo list
Revision ChangesPath
1.4 +35 -75modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
Index: RegistryCooker.pm
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- RegistryCooker.pm 2001/10/19 07:35:26 1.3
+++ RegistryCooker.pm 2001/10/19 10:37:20 1.4
@@ -16,9 +16,6 @@
our $VERSION = '1.99';
use Apache::compat ();
-# META: Should not use Apache::compat, the following methods need to
-# be implemented:
-# $r->slurp_filename
use Apache::Response;
use Apache::Log;
@@ -27,27 +24,10 @@
use ModPerl::Util ();
use ModPerl::Global ();
-#
-# issues
-#
-#
-
-# META: who sets this? What's the default?
unless (defined $ModPerl::Registry::MarkLine) {
$ModPerl::Registry::MarkLine = 1;
}
-### Optimizations
-#
-# - $o->[CLASS] of the subclass is known at compile time, so should
-# create the subs using $o->[CLASS] on the fly for each subclass
-# which wants them
-
-### TODO
-#
-# - who handles END/BEGIN/,CHECK,INIT) blocks?
-# - see META's accross the file
-
#
# debug constants
#
@@ -58,9 +38,9 @@
use constant D_COMPILE => 4;
use constant D_NOISE => 8;
-# can override the debug level in httpd.conf with:
+# the debug level can be overriden on the main server level of
+# httpd.conf with:
# PerlSetVar ModPerl::RegistryCooker::DEBUG 4
-# on the server level
use Apache::ServerUtil ();
use constant DEBUG =>
defined Apache->server->dir_config('ModPerl::RegistryCooker::DEBUG')
@@ -96,26 +76,6 @@
#
-# install the aliases into $class
-#
-#
-
-sub install_aliases {
-my ($class, $rh_aliases) = @_;
-
-no strict 'refs';
-while (my($k,$v) = each %$rh_aliases) {
-if (my $sub = *{$v}{CODE}){
-#warn "$class: ok: $k => $v";
-*{ $class . "::$k" } = $sub;
-}
-else {
-die "$class: $k aliasing failed; sub $v doesn't exist";
-}
-}
-}
-
-#
# func: new
# dflt: new
# args: $class - class to bless into
@@ -128,7 +88,6 @@
my($class, $r) = @_;
my $o = bless [], $class;
$o->init($r);
-#$o->debug("$$: init class: $class");
return $o;
}
@@ -160,7 +119,6 @@
# __PACKAGE__, which is tied to the file)
#
-# META: prototyping ($$) segfaults on request
sub handler {
my $class = (@_ >= 2) ? shift : __PACKAGE__;
my $r = shift;
@@ -219,7 +177,6 @@
$o->flush_namespace;
-# META: handle!
#$o->chdir_file("$Apache::Server::CWD/");
if ( ($rc = $o->error_check) != Apache::OK) {
@@ -291,9 +248,6 @@
# make sure that the sub-package doesn't start with a digit
$package = "_$package";
-# META: ??? explain
-$ModPerl::Registry::curstash = $package;
-
# prepend root
$package = $o->[CLASS] . "::Cache::$package";
@@ -331,12 +285,6 @@
substr($o->[URI], 0, length($o->[URI]) - length($path_info)) :
$o->[URI];
-# META: do we handle this?
-# if ($ModPerl::Registry::NameWithVirtualHost && $o->[REQ]->server->is_virtual)
{
-# my $name = $o->[REQ]->get_server_name;
-# $script_name = join "", $name, $script_name if $name;
-# }
-
$script_name =~ s:/+$:/__INDEX__:;
return $script_name;
@@ -365,10 +313,7 @@
# relative require/open will work.
$o->chdir_file;
-# META: what's this?
-## compile this subroutine into the uniq package name
-#$o->debug("handler eval-ing") if DEBUG & D_NOISE;
-#undef &{"$o->[PACKAGE]\::handler"};# unless $Debug && $Debug & 4; #avoid
warnings
+#undef &{"$o->[PACKAGE]\::handler"}; unless DEBUG & D_NOISE; #avoid warnings
#$o->[PACKAGE]->can('undef_functions') && $o->[PACKAGE]->undef_functions;
my $line = $o->get_mark_line;
@@ -385,22 +330,18 @@
my %orig_inc = %INC;
-#warn "[-- $eval --]";
my $rc = $o->compile(\$eval);
$o->debug(qq{compiled package \"$o->[PACKAGE]\"}
cvs commit: modperl-2.0/ModPerl-Registry TODO
stas01/10/19 03:43:25
Modified:ModPerl-Registry TODO
Log:
- summarize things that have to be done for Registry
Revision ChangesPath
1.2 +44 -26modperl-2.0/ModPerl-Registry/TODO
Index: TODO
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/TODO,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TODO 2001/10/09 12:47:38 1.1
+++ TODO 2001/10/19 10:43:25 1.2
@@ -1,36 +1,54 @@
-- META tags in the modules
+RegistryCooker:
+### bugs ###
- - print STDERR is buffered in test handlers, whereas warn() works
- normally. select() helps, but STDERR should be unbuffered in first
- place.
+- prototyping sub handler($$) segfaults on request
+### missing features ###
-> what's the replacement of NameWithVirtualHost? Obviously we need something
-> to distinguish between vhs.
+- need to port $Apache::__T, to test against when user supplies -T flag.
-DougM: well, if possible we should distinguish between the uri and
-requested resource instead. in otherwords, we have the: r->uri =>
-r->filename translation, just need to figure out if r->filename is the
-actual filename or a symlink (readlink can be used to get the real
-filename). then create a package based on the filename, but with as
-few package:: levels as possible (hopefully none beyond
-ModPerl::RegistryROOT::filename)
+- port Apache::PerlRunXS
-DougM: using filenames makes for long packages names == lengthy
-lookups and more memory than we need. at least the way it is
-currently implemented where each '/' turns into '::'. could be that
-s,/,_,g is good enough, but haven't thought about this for a while.
-in any case, we should get rid of the NameWithVirtualHost stuff, its
-caused too many problems in the past.
+- implement RegistryLoader (per module or a single one?)
+- implement slurp_filename and remove Apache::compat
-Bjarni R. Einarsson <[EMAIL PROTECTED]> has suggested this Registry hack
-http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=98961929702745&w=2
-Message-ID: <[EMAIL PROTECTED]>
+- $r->chdir_file is not handled/implemented, see todo/api.txt unsafe!
+- $Apache::Server::CWD doesn't exist
+
+- NameWithVirtualHost is not handled
+
+- need to figure out what's happening with
+ ModPerl::Registry::MarkLine, why it's not on by default?
+
+- a cousin of convert_script_to_compiled_handler() in 1.x used to have
+ 'undef &{"$o->[PACKAGE]\::handler"}' to avoid redefine handler()
+ warnings in case a user has used -w. also see the undef_functions on
+ the next line.
+
+- child_terminate is not implemented see
+ convert_script_to_compiled_handler().
+
+- print STDERR is buffered in test handlers, whereas warn() works
+ normally. select() helps, but STDERR should be unbuffered in first
+ place.
+
+### optimizations ###
+
+- $o->[CLASS] of the subclass is known at compile time, so should
+ create the subs using $o->[CLASS] on the fly for each subclass
+ which wants them
+
+### nice to have ###
+
+- in namespace_from_filename() should test whether a file is a symlink
+ and if so use readlink() to get the real filename.
+
+### other things ###
+
+- Bjarni R. Einarsson <[EMAIL PROTECTED]> has suggested this Registry hack
+ http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=98961929702745&w=2
+ Message-ID: <[EMAIL PROTECTED]>
cvs commit: modperl-2.0/src/modules/perl modperl_time.h
stas01/10/19 20:35:54
Modified:src/modules/perl modperl_time.h
Log:
- handle platforms which don't have HZ constant defined
Revision ChangesPath
1.2 +8 -2 modperl-2.0/src/modules/perl/modperl_time.h
Index: modperl_time.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_time.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_time.h2001/01/21 23:19:03 1.1
+++ modperl_time.h2001/10/20 03:35:54 1.2
@@ -1,6 +1,12 @@
#ifndef MODPERL_TIME_H
#define MODPERL_TIME_H
+#ifdef HZ
+# define MP_HZ HZ
+#else
+# define MP_HZ 100
+#endif
+
#ifdef MP_TRACE
#define dMP_TIMES \
struct tms start_time; \
@@ -18,9 +24,9 @@
#define MP_PRINT_TIMES(label) \
MP_TRACE_t_do({ \
double utime = \
- (double)(end_time.tms_utime - start_time.tms_utime)/HZ; \
+ (double)(end_time.tms_utime - start_time.tms_utime)/MP_HZ; \
double stime = \
- (double)(end_time.tms_stime - start_time.tms_stime)/HZ; \
+ (double)(end_time.tms_stime - start_time.tms_stime)/MP_HZ; \
if (utime || stime) { \
MP_TRACE_t(MP_FUNC, "%s %5.2f user %5.2f sys\n", \
label, utime, stime); \
cvs commit: modperl-2.0/t/response/TestModperl sameinterp.pm interp.pm
stas01/10/19 20:44:26
Added: t/modperl sameinterp.t
t/response/TestModperl sameinterp.pm
Removed: t/modperl interp.t
t/response/TestModperl interp.pm
Log:
- rename test s/interp/sameinterp/
Revision ChangesPath
1.1 modperl-2.0/t/modperl/sameinterp.t
Index: sameinterp.t
===
use strict;
use warnings FATAL => 'all';
# run tests through the same interpreter, even if the server is
# running more than one
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
plan tests => 12, \&have_lwp;
my $url = "/TestModperl::sameinterp";
# test the tie and re-tie
for (1..2) {
my $same_interp = Apache::TestRequest::same_interp_tie($url);
ok $same_interp;
my $value = 1;
# test GET over the same same_interp
for (1..2) {
$value++;
my $res = Apache::TestRequest::same_interp_do($same_interp, \&GET,
$url, foo => 'bar');
ok t_cmp(
$value,
defined $res && $res->content,
"GET over the same interp");
}
}
{
# test POST over the same same_interp
my $same_interp = Apache::TestRequest::same_interp_tie($url);
ok $same_interp;
my $value = 1;
for (1..2) {
$value++;
my $res = Apache::TestRequest::same_interp_do($same_interp, \&POST,
$url, [ok => $_+3],
content => "foo");
ok t_cmp(
$value,
defined $res && $res->content,
"POST over the same interp");
}
}
{
# test HEAD over the same same_interp
my $same_interp = Apache::TestRequest::same_interp_tie($url);
ok $same_interp;
my $value = 1;
for (1..2) {
$value++;
my $res = Apache::TestRequest::same_interp_do($same_interp, \&HEAD,
$url);
ok t_cmp(
$same_interp,
defined $res && $res->header(Apache::TestRequest::INTERP_KEY),
"HEAD over the same interp");
}
}
1.1 modperl-2.0/t/response/TestModperl/sameinterp.pm
Index: sameinterp.pm
===
package TestModperl::sameinterp;
use warnings FATAL => 'all';
use strict;
use Apache::Const -compile => qw(OK);
my $value = '';
sub handler {
my $r = shift;
# test the actual global data
$value = Apache::TestHandler::same_interp_counter();
$r->puts($value);
Apache::OK;
}
1;
__END__
PerlFixupHandler Apache::TestHandler::same_interp_fixup
