You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/05/10 10:45:59 UTC
cvs commit: modperl/t/net/perl api.pl
dougm 98/05/10 01:45:59
Modified: . Changes Makefile.PL ToDo
lib/Apache PerlRun.pm Registry.pm RegistryLoader.pm
src/modules/perl Apache.xs mod_perl.c
t/net/perl api.pl
Log:
remove Cwd::fastcwd usage from Apache::Registry, use
$Apache::Server::CWD set at server startup instead
new method Apache->chdir_file, use to replace
chdir File::Basename::dirname($r->filename) in Apache::Registry
replace Apache::Registry use of IO::File w/ Apache::gensym
new function Apache::gensym (xsub, does same as Symbol::gensym)
add $ServerRoot/lib/perl to @INC at startup
Revision Changes Path
1.29 +12 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- Changes 1998/05/08 02:40:44 1.28
+++ Changes 1998/05/10 08:45:53 1.29
@@ -18,6 +18,18 @@
=item 1.11_01-dev
+remove Cwd::fastcwd usage from Apache::Registry, use
+$Apache::Server::CWD set at server startup instead
+
+new method Apache->chdir_file, use to replace
+chdir File::Basename::dirname($r->filename) in Apache::Registry
+
+replace Apache::Registry use of IO::File w/ Apache::gensym
+
+new function Apache::gensym (xsub, does same as Symbol::gensym)
+
+add $ServerRoot/lib/perl to @INC at startup
+
overload the get_basic_auth_pw function so we can change AuthType on
the fly via $r->connection->auth_type
1.26 +3 -2 modperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /export/home/cvs/modperl/Makefile.PL,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- Makefile.PL 1998/05/10 04:14:48 1.25
+++ Makefile.PL 1998/05/10 08:45:54 1.26
@@ -124,7 +124,8 @@
$PERL_DESTRUCT_LEVEL = "";
$PERL_STATIC_EXTS = "";
$PERL_EXTRA_CFLAGS = "";
-$Port = $PORT = 8529;
+$Port = 8529;
+$PORT ||= $Port;
$DO_HTTPD = $ENV{DO_HTTPD} || 0;
$NO_HTTPD = $ENV{NO_HTTPD} || 0;
$PERL_TRACE = 0;
@@ -150,7 +151,7 @@
my @mp_args =
qw(EVERYTHING DO_HTTPD NO_HTTPD CONFIG ADD_MODULE
- ALL_HOOKS ADD_VERSION STATIC DYNAMIC);
+ ALL_HOOKS ADD_VERSION STATIC DYNAMIC PORT);
sub is_mp_arg {
my $arg = shift;
1.20 +22 -3 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- ToDo 1998/05/10 04:14:49 1.19
+++ ToDo 1998/05/10 08:45:54 1.20
@@ -16,10 +16,10 @@
(well, close to it anyhow)
---------------------------------------------------------------------------
+- should Apache::Registry use filename instead of vhost_name+uri?
+ Ben Laurie <be...@algroup.co.uk>
+
- make sure SERVER_VERSION/SERVER_SUBVERSION, etc. is in sync w/ 1.3b7 changes
-- get rid of Cwd::fastcwd() usage
-- get rid of IO::File usage, replace with Apache::gensym
-- add chdir_file to replace chdir File::Basename::dirname
- perl-status?mod_perl_hooks broken under win32?
@@ -60,6 +60,25 @@
---------------------------------------------------------------------------
KNOWN BUGS
---------------------------------------------------------------------------
+
+- SIGALRM/flock, Lincoln Stein <ls...@cshl.org>
+ I often use this type of code to handle possibly blocked flocks():
+
+ local($timed_out) = 0;
+ local($SIG{ALRM}) = sub { $timed_out++; die "timed out"; }
+ alarm(5);
+ eval {
+ flock(FH,LOCK_EX);
+ }
+ alarm(0);
+ if ($timed_out) {
+ print "We timed out. Sorry.";
+ }
+
+ This has been working in standalone CGI scripts, but no longer works
+ in mod_perl. The signal handler gets called, but then the flock()
+ call seems to be restarted. It never exit the eval. So this is no big
+ deal, I just replace the blocking flock() with a poll.
- find a way to prevent "httpd spinning" (bug in Perl, not mod_perl)
1.3 +5 -14 modperl/lib/Apache/PerlRun.pm
Index: PerlRun.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/PerlRun.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- PerlRun.pm 1998/05/08 02:40:47 1.2
+++ PerlRun.pm 1998/05/10 08:45:56 1.3
@@ -3,9 +3,6 @@
use strict;
use vars qw($Debug);
use Apache::Constants qw(:common OPT_EXECCGI);
-use File::Basename ();
-use IO::File ();
-use Cwd ();
unless ($Apache::Registry::{NameWithVirtualHost}) {
$Apache::Registry::NameWithVirtualHost = 1;
@@ -109,7 +106,8 @@
my $filename = $r->filename;
$r->log_error("Apache::PerlRun->readscript $filename")
if $Debug && $Debug & 4;
- my $fh = IO::File->new($filename);
+ my $fh = Apache::gensym(__PACKAGE__);
+ open $fh, $filename;
local $/;
my $code = <$fh>;
return \$code;
@@ -126,14 +124,6 @@
return OK;
}
-sub chdir_file {
- my $r = shift;
- my $cwd = Cwd::fastcwd();
- chdir File::Basename::dirname($r->filename);
- *0 = \$r->filename;
- return $cwd;
-}
-
#XXX not good enough yet
my(%switches) = (
'T' => sub {
@@ -175,7 +165,8 @@
my $code = readscript($r);
parse_cmdline($r, $code);
- my $cwd = chdir_file($r);
+ *0 = \$r->filename;
+ $r->chdir_file;
my $eval = join '',
'package ',
@@ -186,7 +177,7 @@
"\n";
compile($r, \$eval);
- chdir $cwd;
+ chdir $Apache::Server::CWD;
{ #flush the namespace
no strict;
1.8 +6 -13 modperl/lib/Apache/Registry.pm
Index: Registry.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/Registry.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Registry.pm 1998/04/20 09:43:48 1.7
+++ Registry.pm 1998/05/10 08:45:56 1.8
@@ -2,12 +2,9 @@
use Apache ();
#use strict; #eval'd scripts will inherit hints
use Apache::Constants qw(:common &OPT_EXECCGI &REDIRECT);
-use FileHandle ();
-use File::Basename ();
-use Cwd ();
-#$Id: Registry.pm,v 1.7 1998/04/20 09:43:48 dougm Exp $
-$Apache::Registry::VERSION = (qw$Revision: 1.7 $)[1];
+#$Id: Registry.pm,v 1.8 1998/05/10 08:45:56 dougm Exp $
+$Apache::Registry::VERSION = (qw$Revision: 1.8 $)[1];
$Apache::Registry::Debug ||= 0;
# 1 => log recompile in errorlog
@@ -84,10 +81,8 @@
$r->log_error("Apache::Registry::handler package $package")
if $Debug && $Debug & 4;
+ $r->chdir_file;
- my $cwd = Cwd::fastcwd();
- chdir File::Basename::dirname($r->filename);
-
if (
exists $Apache::Registry->{$package}{'mtime'}
&&
@@ -99,7 +94,8 @@
if $Debug && $Debug & 4;
my($sub);
{
- my $fh = FileHandle->new($filename);
+ my $fh = Apache::gensym(__PACKAGE__);
+ open $fh, $filename;
local $/;
$sub = <$fh>;
$sub = parse_cmdline($sub);
@@ -137,10 +133,7 @@
my $cv = \&{"$package\::handler"};
eval { &{$cv}($r, @_) } if $r->seqno;
- {
- local $^W = 0; #shutup Cwd.pm
- chdir $cwd;
- }
+ chdir $Apache::Server::CWD;
$^W = $oldwarn;
my $errsv = "";
1.7 +6 -1 modperl/lib/Apache/RegistryLoader.pm
Index: RegistryLoader.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/RegistryLoader.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- RegistryLoader.pm 1998/03/19 23:08:46 1.6
+++ RegistryLoader.pm 1998/05/10 08:45:56 1.7
@@ -5,7 +5,7 @@
use Apache::Registry ();
use Apache::Constants qw(OPT_EXECCGI);
@Apache::RegistryLoader::ISA = qw(Apache::Registry);
-$Apache::RegistryLoader::VERSION = (qw$Revision: 1.6 $)[1];
+$Apache::RegistryLoader::VERSION = (qw$Revision: 1.7 $)[1];
sub new {
my $class = shift;
@@ -50,6 +50,11 @@
sub server { shift }
sub is_virtual {0}
sub header_out {""}
+sub chdir_file {
+ my($r, $file) = @_;
+ $file ||= $r->filename;
+ Apache::chdir_file(undef, $file);
+}
1;
1.22 +14 -0 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- Apache.xs 1998/05/10 04:14:52 1.21
+++ Apache.xs 1998/05/10 08:45:57 1.22
@@ -228,6 +228,8 @@
request_rec *r = NULL;
SV *sv = Nullsv;
+ if(in == &sv_undef) return NULL;
+
if(SvROK(in) && (SvTYPE(SvRV(in)) == SVt_PVHV)) {
int i;
for (i=0; r_keys[i]; i++) {
@@ -618,6 +620,18 @@
#httpd.h
+void
+chdir_file(r, file=r->filename)
+ Apache r
+ const char *file
+
+ CODE:
+ chdir_file(file);
+
+SV *
+mod_perl_gensym(pack="Apache::Symbol")
+ char *pack
+
char *
unescape_url(string)
char *string
1.18 +10 -1 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- mod_perl.c 1998/05/08 02:40:48 1.17
+++ mod_perl.c 1998/05/10 08:45:57 1.18
@@ -344,6 +344,14 @@
U32 mp_debug = 0;
+static void mod_perl_set_cwd(void)
+{
+ char *name = "Apache::Server::CWD";
+ GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PV);
+ SV *cwd = perl_eval_pv("require Cwd; Cwd::fastcwd()", TRUE);
+ sv_setsv(GvSV(gv), cwd);
+}
+
void perl_startup (server_rec *s, pool *p)
{
char *argv[] = { NULL, NULL, NULL, NULL, NULL, NULL, NULL };
@@ -459,7 +467,7 @@
perl_clear_env();
mod_perl_pass_env(p, cls);
-
+ mod_perl_set_cwd();
MP_TRACE_g(fprintf(stderr, "running perl interpreter..."));
ENTER;
@@ -499,6 +507,7 @@
status = perl_run(perl);
av_push(GvAV(incgv), newSVpv(server_root_relative(p,""),0));
+ av_push(GvAV(incgv), newSVpv(server_root_relative(p,"lib/perl"),0));
list = (char **)cls->PerlRequire->elts;
for(i = 0; i < cls->PerlRequire->nelts; i++) {
1.12 +3 -1 modperl/t/net/perl/api.pl
Index: api.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- api.pl 1998/05/10 04:14:59 1.11
+++ api.pl 1998/05/10 08:45:59 1.12
@@ -15,7 +15,7 @@
%ENV = $r->cgi_env;
-my $tests = 38;
+my $tests = 39;
my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
my $test_custom_response = (MODULE_MAGIC_NUMBER >= 19980324) && $tests++;
my $test_dir_config = $INC{'Apache/TestDirectives.pm'} && ($tests += 7);
@@ -28,6 +28,8 @@
$r->print("1..$tests\n");
print "r == $r\n";
test ++$i, $r->filename eq $0;
+test ++$i, -d $Apache::Server::CWD;
+print "\$Apache::Server::CWD == $Apache::Server::CWD\n";
test ++$i, $ENV{GATEWAY_INTERFACE};
test ++$i, defined($r->seqno);