stas 2002/08/16 02:01:17
Modified: ModPerl-Registry TODO
ModPerl-Registry/lib/ModPerl RegistryCooker.pm
RegistryLoader.pm
ModPerl-Registry/t/conf modperl_extra_startup.pl
Log:
- getting rid of compat.pm completely, the only two missing functions,
which are tmp substituted with my_finfo my_slurp_filename, will be
replaced with real function when these are ported.
- also make sure that everything is running under 'use strict'.
- update TODO
Revision Changes Path
1.9 +5 -1 modperl-2.0/ModPerl-Registry/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/TODO,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- TODO 15 Aug 2002 16:16:24 -0000 1.8
+++ TODO 16 Aug 2002 09:01:17 -0000 1.9
@@ -9,13 +9,17 @@
- consider not to use $$ in debug tracing. Not all platforms give out
a different pid for different threads.
+- some problems with setting the DEBUG() constant based on the value of
+ Apache->server->dir_config('ModPerl::RegistryCooker::DEBUG')
+
### missing features ###
- need to port $Apache::__T, to test against when user supplies -T flag.
- port Apache::PerlRunXS
-- implement slurp_filename and remove Apache::compat
+- replace the local implementation of slurp_filename() and finfo(),
+ when these will be ported to mod_perl 2.0
- $r->chdir_file is not handled/implemented, see todo/api.txt unsafe!
1.23 +34 -10 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.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- RegistryCooker.pm 16 Aug 2002 08:05:50 -0000 1.22
+++ RegistryCooker.pm 16 Aug 2002 09:01:17 -0000 1.23
@@ -15,16 +15,21 @@
our $VERSION = '1.99';
-use Apache::compat ();
-
use Apache::Response ();
use Apache::RequestRec ();
-use Apache::Log;
-use Apache::Const -compile => qw(:common &OPT_EXECCGI);
-use File::Spec::Functions ();
+use Apache::RequestIO ();
+use Apache::Log ();
+use Apache::Access ();
+
+use APR::Table ();
+
use ModPerl::Util ();
use ModPerl::Global ();
+use File::Spec::Functions ();
+
+use Apache::Const -compile => qw(:common &OPT_EXECCGI);
+
unless (defined $ModPerl::Registry::MarkLine) {
$ModPerl::Registry::MarkLine = 1;
}
@@ -210,7 +215,7 @@
my $self = shift;
my $r = $self->[REQ];
- unless (-r $r->finfo && -s _) {
+ unless (-r $r->my_finfo && -s _) {
$self->log_error("$self->[FILENAME] not found or unable to stat");
return Apache::NOT_FOUND;
}
@@ -220,13 +225,13 @@
$self->[MTIME] = -M _;
unless (-x _ or IS_WIN32) {
- $r->log_reason("file permissions deny server execution",
+ $r->log_error("file permissions deny server execution",
$self->[FILENAME]);
return Apache::FORBIDDEN;
}
if (!($r->allow_options & Apache::OPT_EXECCGI)) {
- $r->log_reason("Options ExecCGI is off in this directory",
+ $r->log_error("Options ExecCGI is off in this directory",
$self->[FILENAME]);
return Apache::FORBIDDEN;
}
@@ -440,7 +445,7 @@
# wasn't modified
sub should_compile_if_modified {
my $self = shift;
- $self->[MTIME] ||= -M $self->[REQ]->finfo;
+ $self->[MTIME] ||= -M $self->[REQ]->my_finfo;
!($self->is_cached &&
$self->cache_table->{ $self->[PACKAGE] }{mtime} <= $self->[MTIME]);
}
@@ -519,7 +524,7 @@
my $self = shift;
$self->debug("reading $self->[FILENAME]") if DEBUG & D_NOISE;
- $self->[CODE] = $self->[REQ]->slurp_filename;
+ $self->[CODE] = $self->[REQ]->my_slurp_filename;
}
#########################################################################
@@ -741,6 +746,25 @@
Apache->warn("$$: cannot find $package in cache");
}
}
+
+
+# XXX: these should go away when finfo() and slurp_filename() are
+# ported to 2.0 (don't want to depend on compat.pm)
+sub Apache::RequestRec::my_finfo {
+ my $r = shift;
+ stat $r->filename;
+ \*_;
+}
+
+sub Apache::RequestRec::my_slurp_filename {
+ my $r = shift;
+ open my $fh, $r->filename;
+ local $/;
+ my $data = <$fh>;
+ close $fh;
+ return \$data;
+}
+
1;
__END__
1.4 +15 -7 modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
Index: RegistryLoader.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- RegistryLoader.pm 16 Aug 2002 08:05:50 -0000 1.3
+++ RegistryLoader.pm 16 Aug 2002 09:01:17 -0000 1.4
@@ -1,6 +1,10 @@
package ModPerl::RegistryLoader;
-use Apache::Process;
+use strict;
+use warnings;
+
+use ModPerl::RegistryCooker ();
+use APR::Pool ();
use Apache::Const -compile => qw(OK HTTP_OK OPT_EXECCGI);
use Carp;
@@ -12,6 +16,7 @@
sub create {
my $class = shift;
my $self = bless {@_} => ref($class)||$class;
+ $self->{pool} = APR::Pool->new();
$self->load_package($self->{package});
return $self;
}
@@ -48,8 +53,8 @@
$self->warn("Trying to guess filename based on uri")
if $self->{debug};
- my $pool = Apache->server->process->pool;
- $filename = Apache::server_root_relative($pool, $guess);
+
+ $filename = Apache::server_root_relative($self->{pool}, $guess);
unless (-e $filename) {
$self->warn("Cannot find guessed file: $filename",
"provide \$filename or 'trans' sub");
@@ -72,14 +77,17 @@
}
+# XXX: s/my_// for qw(my_finfo my_slurp_filename);
+# when when finfo() and slurp_filename() are ported to 2.0 and
+# RegistryCooker is starting to use them
+
sub filename { shift->{filename} }
sub status { Apache::HTTP_OK }
-sub finfo { shift->{filename} }
+sub my_finfo { shift->{filename} }
sub uri { shift->{uri} }
sub path_info {}
sub allow_options { Apache::OPT_EXECCGI } #will be checked again at run-time
sub log_error { shift; die @_ if $@; warn @_; }
-*log_reason = \&log_error;
sub run { return Apache::OK } # don't run the script
sub server { shift }
@@ -92,10 +100,10 @@
# override Apache class methods called by Modperl::Registry*. normally
# only available at request-time via blessed request_rec pointer
-sub slurp_filename {
+sub my_slurp_filename {
my $r = shift;
my $filename = $r->filename;
- open my $fh, $filename;
+ open my $fh, $filename or die "can't open $filename: $!";
local $/;
my $code = <$fh>;
return \$code;
1.4 +9 -14 modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl
Index: modperl_extra_startup.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_extra_startup.pl 16 Aug 2002 08:01:18 -0000 1.3
+++ modperl_extra_startup.pl 16 Aug 2002 09:01:17 -0000 1.4
@@ -1,21 +1,18 @@
-#
use strict;
use warnings FATAL => 'all';
-# XXX: this should go
-use Apache::compat;
-
-use Apache::ServerUtil;
-use Apache::Process;
-use APR::Pool;
-
use ModPerl::RegistryLoader ();
-my $rl = ModPerl::RegistryLoader->create(package => "ModPerl::Registry");
+use Apache::ServerUtil ();
+use APR::Pool ();
+
+use DirHandle ();
-my $pool = Apache->server->process->pool;
+my $pool = APR::Pool->new();
my $base_dir = Apache::server_root_relative($pool, "cgi-bin");
+
# test the scripts pre-loading by explicitly specifying uri => filename
+my $rl = ModPerl::RegistryLoader->create(package => "ModPerl::Registry");
my $base_uri = "/cgi-bin";
for my $file (qw(basic.pl env.pl)) {
my $file_path = "$base_dir/$file";
@@ -23,11 +20,9 @@
$rl->handler($uri, $file_path);
}
-{
- # test the scripts pre-loading by using trans sub
- use DirHandle ();
- use strict;
+# test the scripts pre-loading by using trans sub
+{
sub trans {
my $uri = shift;
$uri =~ s|^/registry_bb/|cgi-bin/|;
