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/18 01:31:57 UTC
cvs commit: modperl/t/net/perl test tie_table.pl
dougm 98/05/17 16:31:56
Modified: . Changes ToDo apache-modlist.html
Apache Apache.pm
src/modules/perl ModuleConfig.xs Tie.xs mod_perl.h
perl_config.c perl_util.c
t/modules embperl.t
t/net/perl test tie_table.pl
Log:
Apache::system
various -Wall cleanup, etc.
Revision Changes Path
1.31 +3 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- Changes 1998/05/14 03:06:50 1.30
+++ Changes 1998/05/17 23:31:50 1.31
@@ -18,6 +18,9 @@
=item 1.11_01-dev
+added little Apache::system that redirects output to the browser,
+should this be imported into Apache::{Registry,PerlRun} scripts?
+
new Apache::Tie module, provides Apache::TieHashTable for a proper
interface to Apache table structures. The following methods, called
in a scalar context with no "key" argument, will return a HASH
1.22 +31 -24 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- ToDo 1998/05/14 03:06:51 1.21
+++ ToDo 1998/05/17 23:31:50 1.22
@@ -16,38 +16,28 @@
(well, close to it anyhow)
---------------------------------------------------------------------------
-- some mod_perlIO type methods for xs modules? (e.g. Apache::Peek)
+- Gerald's report of Embperl/sub-request/print breakage
-- 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
- perl-status?mod_perl_hooks broken under win32?
-- documentation:
- + modperl.opensrc.org
- + PerlRun::handler
- + Frank's FAQ update: http://www.ping.de/~fdc/mod_perl/mod_perl_faq.tar.gz
- + DONE
- + SUID access http://www.courtesan.com/sudo/
- + $ENV{PATH}/PerlSetEnv and PerlTaintCheck
-
- rand() broken under win32!
Jeff Baker <je...@godzilla.tamu.edu>
- Ralf's APACI Makefile.tmpl
-- AIX 3.2.5, mod_perl and sfio97 problem
- Jeff Drumm <DR...@MAIL.MMC.ORG>
-
-- PerlOptions directive?
- Jason Riedy <ej...@cise.ufl.edu>
+- $ENV{PATH}: don't let perl_clear_env() change it's value
-- read_client_block/read
- Brian Slesinsky <bs...@best.com>
-- read_client_block/fileupload
- Ed Jordan <ed...@fidalgo.net>
+- documentation
+ + modperl.opensrc.org
+ + PerlRun::handler
+ + Frank's FAQ update: http://www.ping.de/~fdc/mod_perl/mod_perl_faq.tar.gz
+ + DONE
+ + SUID access http://www.courtesan.com/sudo/
+ + $ENV{PATH}/PerlSetEnv and PerlTaintCheck
+ + PerlHandler Apache::Registry vs. PerlHandler Apache::Registry::handler
+ + IO.so and -Xlinker -E "Salvador Fandi�o" <fa...@usa.net>
---------------------------------------------------------------------------
DOCUMENTATION (areas that *really* need some more or don't have any)
@@ -63,6 +53,10 @@
KNOWN BUGS
---------------------------------------------------------------------------
+- bytes_sent are not logged if header don't go through send_http_header(),
+ e.g CGI->header(-nph => 1, ...)
+ Eric Cholet <ch...@logilune.com>
+
- SIGALRM/flock, Lincoln Stein <ls...@cshl.org>
I often use this type of code to handle possibly blocked flocks():
@@ -126,6 +120,17 @@
NEW STUFF
---------------------------------------------------------------------------
+- move away from read_client_block to {setup,should,get}_client_block
+ see Apache.pm/Apache::new_read
+
+- PerlOptions directive?
+ Jason Riedy <ej...@cise.ufl.edu>
+
+- some mod_perlIO type methods for xs modules? (e.g. Apache::Peek)
+
+- method to fetch current value of <Location ...>?
+ "Simon Matthews" <sa...@peritas.com>
+
- make 'PerlSetVar $Foo value' work like 'local $Foo = value'
for the given location
@@ -209,6 +214,11 @@
NEW MODULE STUFF
---------------------------------------------------------------------------
+- should Apache::Registry use filename instead of vhost_name+uri?
+ Ben Laurie <be...@algroup.co.uk>
+
+- Apache::Util: functions from apache's util*.c files
+
- apache.pm: use apache '1.3b3';
- have Apache::Status hunt for AUTOLOADing
@@ -232,7 +242,4 @@
CLEANUPS - "if it ain't broke, don't muck with it", but we should tidy
these things at some point
---------------------------------------------------------------------------
-
-- no longer need local $^W = 0; #shutup Cwd.pm,
- Ian Kallen <ia...@gamespot.com>
1.13 +2 -1 modperl/apache-modlist.html
Index: apache-modlist.html
===================================================================
RCS file: /export/home/cvs/modperl/apache-modlist.html,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- apache-modlist.html 1998/05/14 03:06:51 1.12
+++ apache-modlist.html 1998/05/17 23:31:50 1.13
@@ -7,7 +7,7 @@
<h1>The Apache/Perl Module List</h1>
Maintained by <a href="mailto:dougm@osf.org">Doug MacEachern</a>,
-<br><i> $Revision: 1.12 $ $Date: 1998/05/14 03:06:51 $</i>
+<br><i> $Revision: 1.13 $ $Date: 1998/05/17 23:31:50 $</i>
<h3>Contents</h3>
<a href="#intro">Introduction</a><br>
@@ -173,6 +173,7 @@
Servlet ampO Interface to the Java Servlet engine IKLUFT
Sfio cmcO Interface to r->connection->client->sf* DOUGM
Tie bmcO Tie interfaces to Apache structures APML
+Util cmcf Interface to Apache's util*.c functions APML
* Development and Debug tools
Debug Rmpf mod_perl debugging utilities APML
1.9 +5 -1 modperl/Apache/Apache.pm
Index: Apache.pm
===================================================================
RCS file: /export/home/cvs/modperl/Apache/Apache.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- Apache.pm 1998/05/08 02:40:46 1.8
+++ Apache.pm 1998/05/17 23:31:52 1.9
@@ -4,7 +4,7 @@
use Apache::Constants qw(OK DECLINED);
use Apache::SIG ();
-@Apache::EXPORT_OK = qw(exit warn fork forkoption);
+@Apache::EXPORT_OK = qw(system exit warn fork forkoption);
$Apache::VERSION = "1.22";
*import = \&Exporter::import;
@@ -164,6 +164,10 @@
my($r, $buff, $length, $offset) = @_;
my $send = substr($buff, $offset, $length);
$r->print($send);
+}
+
+sub system {
+ print `@_`;
}
sub send_cgi_header {
1.3 +13 -3 modperl/src/modules/perl/ModuleConfig.xs
Index: ModuleConfig.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/ModuleConfig.xs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ModuleConfig.xs 1998/05/14 03:06:56 1.2
+++ ModuleConfig.xs 1998/05/17 23:31:52 1.3
@@ -76,8 +76,13 @@
MODULE = Apache::ModuleConfig PACKAGE = Apache::ModuleConfig
+PROTOTYPES: DISABLE
+
+BOOT:
+ items = items; /*avoid warning*/
+
SV *
-get(self, obj, svkey=Nullsv)
+get(self=Nullsv, obj, svkey=Nullsv)
SV *self
SV *obj
SV *svkey
@@ -92,7 +97,7 @@
if((svkey == Nullsv) || caller) {
HV *xs_config = perl_get_hv("Apache::XS_ModuleConfig", TRUE);
- SV **mod_ptr;
+ SV **mod_ptr = (SV**)NULL;
if(!caller)
caller = perl_eval_pv("scalar caller", TRUE);
@@ -106,7 +111,12 @@
void *ptr = vector_from_sv(obj, &type);
mod_perl_perl_dir_config *data =
get_module_config(ptr, (module *)tmp);
- RETVAL = data->obj ? SvREFCNT_inc(data->obj) : Nullsv;
+ if(data->obj) {
+ ++SvREFCNT(data->obj);
+ RETVAL = data->obj;
+ }
+ else
+ RETVAL = Nullsv;
}
}
if(!RETVAL) XSRETURN_UNDEF;
1.2 +13 -1 modperl/src/modules/perl/Tie.xs
Index: Tie.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Tie.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Tie.xs 1998/05/14 03:02:22 1.1
+++ Tie.xs 1998/05/17 23:31:53 1.2
@@ -11,12 +11,18 @@
MODULE = Apache::Tie PACKAGE = Apache::TieHashTable
+PROTOTYPES: DISABLE
+
+BOOT:
+ items = items; /*avoid warning*/
+
Apache::TieHashTable
TIEHASH(class, table)
SV *class
Apache::Table table
CODE:
+ if(!class) XSRETURN_UNDEF;
RETVAL = (Apache__TieHashTable)safemalloc(sizeof(apache_tiehash_table));
RETVAL->table = table;
RETVAL->ix = 0;
@@ -42,6 +48,7 @@
get = 1
CODE:
+ ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
RETVAL = table_get(self->table, key);
@@ -72,10 +79,13 @@
I32 gimme = GIMME_V;
CODE:
+ ix = ix;
if(!self->table) XSRETURN_UNDEF;
+ RETVAL = NULL;
if(gimme != G_VOID)
RETVAL = table_get(self->table, key);
table_unset(self->table, key);
+ if(!RETVAL) XSRETURN_UNDEF;
OUTPUT:
RETVAL
@@ -90,6 +100,7 @@
set = 1
CODE:
+ ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
table_set(self->table, key, val);
@@ -101,11 +112,12 @@
clear = 1
CODE:
+ ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
clear_table(self->table);
const char *
-NEXTKEY(self, lastkey)
+NEXTKEY(self, lastkey=Nullsv)
Apache::TieHashTable self
SV *lastkey
1.22 +4 -1 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- mod_perl.h 1998/05/14 03:06:56 1.21
+++ mod_perl.h 1998/05/17 23:31:53 1.22
@@ -197,7 +197,9 @@
#endif
/* cut down on some noise in source */
-#define dSTATUS int status = DECLINED, dstatus
+#define dSTATUS \
+int dstatus = DECLINED; \
+int status = dstatus
#define dPPDIR \
perl_dir_config *cld = get_module_config(r->per_dir_config, &perl_module)
@@ -893,6 +895,7 @@
I32 perl_module_is_loaded(char *name);
SV *perl_module2file(char *name);
int perl_require_module(char *module, server_rec *s);
+void perl_qrequire_module (char *name);
int perl_load_startup_script(server_rec *s, pool *p, char *script, I32 my_warn);
array_header *perl_cgi_env_init(request_rec *r);
void perl_clear_env(void);
1.18 +1 -1 modperl/src/modules/perl/perl_config.c
Index: perl_config.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- perl_config.c 1998/05/14 03:06:56 1.17
+++ perl_config.c 1998/05/17 23:31:53 1.18
@@ -1205,7 +1205,7 @@
/* make sure this module is re-loaded for the second config read */
if(PERL_RUNNING() == 1) {
- SV *file;
+ SV *file = Nullsv;
if(arg) {
if(strrchr(arg, '/') || strrchr(arg, '.'))
file = newSVpv((char *)arg,0);
1.8 +15 -1 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- perl_util.c 1998/05/14 03:06:57 1.7
+++ perl_util.c 1998/05/17 23:31:53 1.8
@@ -109,7 +109,7 @@
SV *sv = sv_newmortal();
iniHV(hv);
sv_setref_pv(sv, "Apache::Table", (void*)t);
- perl_require_module("Apache::Tie", NULL);
+ perl_qrequire_module("Apache::Tie");
perl_tie_hash(hv, "Apache::TieHashTable", sv);
return newRV_noinc((SV*)hv);
}
@@ -363,6 +363,20 @@
MP_TRACE_d(fprintf(stderr, "ok\n"));
return 0;
+}
+
+/* faster than require_module,
+ * used when we're already in an eval context
+ */
+void perl_qrequire_module(char *name)
+{
+ OP *mod;
+ SV *key = perl_module2file(name);
+ if((key && hv_exists_ent(GvHV(incgv), key, FALSE)))
+ return;
+ mod = newSVOP(OP_CONST, 0, key);
+ /*mod->op_private |= OPpCONST_BARE;*/
+ utilize(TRUE, start_subparse(FALSE, 0), Nullop, mod, Nullop);
}
void perl_do_file(char *pv)
1.3 +6 -0 modperl/t/modules/embperl.t
Index: embperl.t
===================================================================
RCS file: /export/home/cvs/modperl/t/modules/embperl.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- embperl.t 1998/04/20 05:16:25 1.2
+++ embperl.t 1998/05/17 23:31:55 1.3
@@ -1,6 +1,12 @@
use Apache::test;
+if($ENV{USER} eq 'dougm' and
+ $net::callback_hooks{MMN} < 19980413)
+{
+ skip_test; #1.3b6 broke binary compat
+}
+
skip_test unless have_module "HTML::Embperl";
print "1..1\n";
1.7 +5 -0 modperl/t/net/perl/test
Index: test
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/test,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- test 1998/05/08 02:40:51 1.6
+++ test 1998/05/17 23:31:55 1.7
@@ -105,6 +105,11 @@
$r->print("\nContent\n-------\n$content");
}
+print "\n";
+if(defined &Apache::system and \&system == \&Apache::system) {
+ system qq{$Config::Config{perlpath} -le 'print "Apache::system ok"'};
+}
+
#even though we exit() here, END block below is still called
test_exit(); # unless $ENV{CONTENT_LENGTH};
1.2 +8 -16 modperl/t/net/perl/tie_table.pl
Index: tie_table.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/tie_table.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- tie_table.pl 1998/05/14 03:01:28 1.1
+++ tie_table.pl 1998/05/17 23:31:56 1.2
@@ -35,28 +35,20 @@
%$headers_in = %save;
-print "headers_in:\n";
-while(my($k,$v) = each %$headers_in) {
- print "$k = $v\n";
-}
-
-print "TOTAL: ", scalar keys %$headers_in, "\n\n";
-
-my $dir_config = $r->dir_config;
-
-print "dir_config:\n";
-while(my($k,$v) = each %$dir_config) {
- print "$k = $v\n";
-}
-
-print "TOTAL: ", scalar keys %$dir_config, "\n\n";
-
for my $meth (qw{
headers_in headers_out err_headers_out notes dir_config subprocess_env
})
{
my $hash_ref = $r->$meth();
my $tab = tied %$hash_ref;
+
+ print "$meth:\n";
+ while(my($k,$v) = each %$hash_ref) {
+ print "$k = $v\n";
+ }
+
+ print "TOTAL: ", scalar keys %$hash_ref, "\n\n";
+
test ++$i, UNIVERSAL::isa($hash_ref, 'HASH');
test ++$i, $tab->isa('Apache::TieHashTable');
}