On Thu, 27 Sep 2001, Doug MacEachern wrote:
> On Fri, 28 Sep 2001, Stas Bekman wrote:
>
> > issues:
> > - missing ALIAS for Apache::Server::dir_config (don't know how to make it
> > work with auto-auto-auto-generator :)
>
> add the common function to modperl_util.c, then it can be called from
> anywhere.
what common function? to create ALIASes? or dir_config? please explain,
thanks!
> > - this patch is weird as it includes 3 different implementations of
> > dir_config, dir_config_old, dir_config_xs - please pick the right one.
> > the test actually tests only dir_config, but they all should work.
>
> dir_config with the (table, key=NULL, val=NULL) prototype.
you mean the XS version, right?
> > - perl_get_startup_server() from 1.x, I couldn't find it in 2.x (probably
> > it's not implemented yet, so it's in the comment XXX)
>
> its called modperl_global_get_server_rec(); in 2.0
thanks!
> if you could resubmit with just the 1 dir_config implementation that would
> make it much easier to review, thanks :)
here we go:
Index: t/response/TestAPI/request_rec.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/request_rec.pm,v
retrieving revision 1.7
diff -u -r1.7 request_rec.pm
--- t/response/TestAPI/request_rec.pm 2001/09/15 19:34:12 1.7
+++ t/response/TestAPI/request_rec.pm 2001/09/28 02:03:13
@@ -4,11 +4,12 @@
use warnings FATAL => 'all';
use Apache::Test;
+use Apache::TestUtil;
sub handler {
my $r = shift;
- plan $r, tests => 40;
+ plan $r, tests => 46, todo => [35];
#Apache->request($r); #PerlOptions +GlobalRequest takes care
my $gr = Apache->request;
@@ -86,6 +87,63 @@
#user
+ #<- dir_config tests ->#
+
+ # this test doesn't test all $r->dir_config->*(), since
+ # dir_config() returns a generic APR::Table which is tested in
+ # apr/table.t.
+
+ # object test
+ my $dir_config = $r->dir_config;
+ ok defined $dir_config && ref($dir_config) eq 'APR::Table';
+
+ {
+ my $key = make_key('0');
+
+ # object interface test in a scalar context (for a single
+ # PerlSetVar key)
+ ok t_cmp("SetValue0",
+ $dir_config->get($key),
+ qq{\$dir_config->get("$key")});
+
+ # direct fetch test in a scalar context (for a single
+ # PerlSetVar)
+ ok t_cmp("SetValue0",
+ $r->dir_config($key),
+ qq{\$r->dir_config("$key")});
+ }
+
+ # test non-existent key
+ {
+ my $key = make_key();
+ ok t_cmp(undef,
+ $r->dir_config($key),
+ qq{\$r->dir_config("$key")});
+ }
+
+ # make this non-todo when the following works:
+ # my @received = $dir_config->get($key)
+ # PerlAddVar ITERATE2 test
+ {
+ my $key = make_key('1');
+ my @received = $dir_config->get($key);
+ my @expected = qw(AddValue1_1 AddValue1 SetValue1);
+ my $ok = 1;
+ for (0..$#expected) {
+ $ok = 0 unless defined $received[$_]
+ && $expected[$_] eq $received[$_];
+ }
+ ok $ok;
+ }
+
+ # test PerlSetVar set in base config
+ {
+ my $key = make_key('_set_in_Base');
+ ok t_cmp("BaseValue",
+ $r->dir_config($key),
+ qq{\$r->dir_config("$key")});
+ }
+
#no_cache
ok $r->no_cache || 1;
@@ -128,6 +186,24 @@
0;
}
+my $key_base = "TestAPI__request_rec_Key";
+my $counter = 0;
+sub make_key{
+ return $key_base .
+ (defined $_[0]
+ ? $_[0]
+ : unpack "H*", pack "n", ++$counter . rand(100) );
+}
1;
__END__
+<Base>
+ PerlSetVar TestAPI__request_rec_Key_set_in_Base BaseValue
+</Base>
PerlOptions +GlobalRequest
+
+PerlSetVar TestAPI__request_rec_Key0 SetValue0
+
+PerlSetVar TestAPI__request_rec_Key1 ToBeLost
+PerlSetVar TestAPI__request_rec_Key1 SetValue1
+PerlAddVar TestAPI__request_rec_Key1 AddValue1 AddValue1_1
+
Index: xs/modperl_xs_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/modperl_xs_util.h,v
retrieving revision 1.9
diff -u -r1.9 modperl_xs_util.h
--- xs/modperl_xs_util.h 2001/09/25 19:44:03 1.9
+++ xs/modperl_xs_util.h 2001/09/28 02:03:13
@@ -92,4 +92,34 @@
MARK++; \
}
+#define TABLE_GET_SET(table, do_taint) \
+ if (table == NULL) { \
+ RETVAL = &PL_sv_undef; \
+ } \
+ else if (key == NULL) { \
+ RETVAL = modperl_hash_tie(aTHX_ "APR::Table", Nullsv, (void*)table); \
+ } \
+ else if (val == NULL) { \
+ char *val; \
+ if ((val = (char *)apr_table_get(table, key))) { \
+ RETVAL = newSVpv(val, 0); \
+ } \
+ else { \
+ RETVAL = newSV(0); \
+ } \
+ if (do_taint) { \
+ SvTAINTED_on(RETVAL); \
+ } \
+ } \
+ else { \
+ if (val == (const char *)SvPV_nolen(&PL_sv_undef)) { \
+ apr_table_unset(table, key); \
+ } \
+ else { \
+ apr_table_set(table, key, val); \
+ } \
+ }
+
+
+
#endif /* MODPERL_XS_H */
Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
retrieving revision 1.6
diff -u -r1.6 Apache__RequestUtil.h
--- xs/Apache/RequestUtil/Apache__RequestUtil.h 2001/09/08 18:26:46 1.6
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h 2001/09/28 02:03:13
@@ -168,7 +168,7 @@
if (r->no_cache) {
apr_table_setn(r->headers_out, "Pragma", "no-cache");
apr_table_setn(r->headers_out, "Cache-control", "no-cache");
- }
+ }
else if (flag) { /* only unset if $r->no_cache(0) */
apr_table_unset(r->headers_out, "Pragma");
apr_table_unset(r->headers_out, "Cache-control");
@@ -176,3 +176,55 @@
return retval;
}
+
+static XS(MPXS_Apache__RequestRec_dir_config)
+{
+ dXSARGS;
+
+ if (items < 1 || items > 3) {
+ Perl_croak(aTHX_ "Usage: $r->dir_config($key=NULL, $val=NULL)");
+ }
+
+ SP -= items;
+ {
+ char *key;
+ char *val;
+ Apache__RequestRec r = modperl_xs_sv2request_rec(aTHX_ ST(0),
+"Apache::RequestRec", cv);
+ SV *RETVAL;
+
+ if (items < 2) {
+ key = NULL;
+ } else {
+ key = (char *)SvPV_nolen(ST(1));
+ }
+
+ if (items < 3) {
+ val = NULL;
+ } else {
+ val = (char *)SvPV_nolen(ST(2));
+ }
+
+ if (r && r->per_dir_config) {
+ MP_dDCFG;
+ TABLE_GET_SET(dcfg->SetVar, FALSE);
+ }
+
+ if (!SvTRUE(RETVAL)) {
+ server_rec *s = r && r->server ? r->server :
+modperl_global_get_server_rec();
+
+ if (s && s->module_config) {
+ MP_dSCFG(s);
+ SvREFCNT_dec(RETVAL); /* in case above did newSV(0) */
+ TABLE_GET_SET(scfg->SetVar, FALSE);
+ } else {
+ RETVAL = &PL_sv_undef;
+ }
+ }
+
+ ST(0) = RETVAL;
+ sv_2mortal(ST(0));
+ }
+ XSRETURN(1);
+
+}
+
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.19
diff -u -r1.19 modperl_functions.map
--- xs/maps/modperl_functions.map 2001/09/15 17:57:25 1.19
+++ xs/maps/modperl_functions.map 2001/09/28 02:03:13
@@ -11,6 +11,7 @@
mpxs_Apache__RequestRec_no_cache | | r, flag=Nullsv
PACKAGE=Apache::RequestRec
mpxs_Apache__RequestRec_new | | classname, c, base_pool=NULL
+DEFINE_dir_config | MPXS_Apache__RequestRec_dir_config | ...
PACKAGE=Apache
mpxs_Apache_request | | classname, svr=Nullsv
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
