stas 2003/01/28 19:56:00
Modified: . Changes
t/response/TestApache conftree.pm
xs/Apache/Directive Apache__Directive.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
Log:
New Apache::Directive methods: as_hash(), lookup() + tests
Submitted by: Philippe M. Chiasson <[EMAIL PROTECTED]>
Reviewed by: stas
Revision Changes Path
1.117 +3 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -r1.116 -r1.117
--- Changes 29 Jan 2003 01:04:33 -0000 1.116
+++ Changes 29 Jan 2003 03:56:00 -0000 1.117
@@ -10,6 +10,9 @@
=item 1.99_09-dev
+New Apache::Directive methods: as_hash(), lookup() + tests + docs
+[Philippe M. Chiasson <[EMAIL PROTECTED]>]
+
Stacked handlers chain execution is now aborted when a handler returns
something other than OK or DECLINED [Stas]
1.5 +25 -27 modperl-2.0/t/response/TestApache/conftree.pm
Index: conftree.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/conftree.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- conftree.pm 19 May 2002 01:12:24 -0000 1.4
+++ conftree.pm 29 Jan 2003 03:56:00 -0000 1.5
@@ -4,6 +4,7 @@
use warnings FATAL => 'all';
use Apache::Test;
+use Apache::TestUtil;
use Apache::TestConfig ();
use Apache::Directive ();
@@ -14,7 +15,7 @@
my $r = shift;
my $cfg = Apache::Test::config();
- plan $r, tests => 7;
+ plan $r, tests => 8;
ok $cfg;
@@ -26,43 +27,40 @@
ok $tree;
- my $port = find_config_val($tree, 'Listen');
+ my $port = $tree->lookup('Listen');
- ok $port;
+ ok t_cmp($vars->{port}, $port);
- ok $port == $vars->{port};
+ my $documentroot = $tree->lookup('DocumentRoot');
- my $documentroot = find_config_val($tree, 'DocumentRoot');
+ ok t_cmp('HASH' , ref($tree->as_hash()), 'as_hash');
- ok $documentroot;
+ ok t_cmp(qq("$vars->{documentroot}"), $documentroot);
- ok $documentroot eq qq("$vars->{documentroot}");
+ ok t_cmp(qq("$vars->{documentroot}"), $tree->lookup("DocumentRoot"));
- Apache::OK;
-}
-
-sub find_config_val {
- my($tree, $directive) = @_;
+ #XXX: This test isn't so good, but its quite problematic to try
+ #and _really_ compare $cfg and $tree...
+ {
+ my %vhosts = map {
+ $cfg->{vhosts}{$_}{name} => { %{$cfg->{vhosts}{$_}}, index => $_ }
+ } keys %{$cfg->{vhosts}};
- while ($tree) {
- if ($directive eq $tree->directive) {
- return $tree->args;
+ for my $v (keys %vhosts) {
+ $vhosts{ $vhosts{$v}{index} } = $vhosts{$v};
}
- if (my $kid = $tree->first_child) {
- $tree = $kid;
- } elsif (my $next = $tree->next) {
- $tree = $next;
- }
- else {
- if (my $parent = $tree->parent) {
- $tree = $parent->next;
- }
- else {
- $tree = undef;
+ my $vhost_failed;
+ for my $vhost ($tree->lookup("VirtualHost")) {
+ unless (exists $vhosts{$vhost->{'ServerName'}
+ || $vhost->{'PerlProcessConnectionHandler'}}) {
+ $vhost_failed++;
}
}
+
+ ok !$vhost_failed;
}
-}
+ Apache::OK;
+}
1;
1.6 +162 -0 modperl-2.0/xs/Apache/Directive/Apache__Directive.h
Index: Apache__Directive.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/Directive/Apache__Directive.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Apache__Directive.h 5 Sep 2002 01:47:39 -0000 1.5
+++ Apache__Directive.h 29 Jan 2003 03:56:00 -0000 1.6
@@ -17,3 +17,165 @@
return sv;
}
+
+
+/* Adds an entry to a hash, vivifying hash/array for multiple entries */
+static void hash_insert(pTHX_ HV *hash, const char *key,
+ int keylen, const char *args,
+ int argslen, SV *value)
+{
+ HV *subhash;
+ AV *args_array;
+ SV **hash_ent = hv_fetch(hash, key, keylen, 0);
+
+ if (value) {
+ if (!hash_ent) {
+ subhash = newHV();
+ hv_store(hash, key, keylen, newRV_noinc((SV *)subhash), 0);
+ }
+ else {
+ subhash = (HV *)SvRV(*hash_ent);
+ }
+
+ hv_store(subhash, args, argslen, value, 0);
+ }
+ else {
+ if (hash_ent) {
+ if (SvROK(*hash_ent) && (SVt_PVAV == SvTYPE(SvRV(*hash_ent)))) {
+ args_array = (AV *)SvRV(*hash_ent);
+ }
+ else {
+ args_array = newAV();
+ av_push(args_array, newSVsv(*hash_ent));
+ hv_store(hash, key, keylen, newRV_noinc((SV *)args_array), 0);
+ }
+ av_push(args_array, newSVpv(args, argslen));
+ }
+ else {
+ hv_store(hash, key, keylen, newSVpv(args, argslen), 0);
+ }
+ }
+}
+
+static MP_INLINE SV* mpxs_Apache__Directive_as_hash(pTHX_
+ ap_directive_t *tree)
+{
+ const char *directive;
+ int directive_len;
+ const char *args;
+ int args_len;
+
+ HV *hash = newHV();
+ SV *subtree;
+
+ while (tree) {
+ directive = tree->directive;
+ directive_len = strlen(directive);
+ args = tree->args;
+ args_len = strlen(args);
+
+ if (tree->first_child) {
+
+ /* Skip the prefix '<' */
+ if ('<' == directive[0]) {
+ directive++;
+ directive_len--;
+ }
+
+ /* Skip the postfix '>' */
+ if ('>' == args[args_len-1]) {
+ args_len--;
+ }
+
+ subtree = mpxs_Apache__Directive_as_hash(aTHX_ tree->first_child);
+ hash_insert(aTHX_ hash, directive, directive_len,
+ args, args_len, subtree);
+ }
+ else {
+ hash_insert(aTHX_ hash, directive, directive_len,
+ args, args_len, Nullsv);
+ }
+
+ tree = tree->next;
+ }
+
+ return newRV_noinc((SV *)hash);
+}
+
+static XS(MPXS_Apache__Directive_lookup)
+{
+ dXSARGS;
+
+ if (items < 2 || items > 3) {
+ Perl_croak(aTHX_
+ "Usage: Apache::Directive::lookup(self, key, [args])");
+ }
+
+ mpxs_PPCODE({
+ Apache__Directive tree;
+ char *value;
+ const char *directive;
+ const char *args;
+ int args_len;
+ int directive_len;
+
+ char *key = (char *)SvPV_nolen(ST(1));
+ int scalar_context = (G_SCALAR == GIMME_V);
+
+ if (SvROK(ST(0)) && sv_derived_from(ST(0), "Apache::Directive")) {
+ IV tmp = SvIV((SV*)SvRV(ST(0)));
+ tree = INT2PTR(Apache__Directive,tmp);
+ }
+ else {
+ tree = ap_conftree;
+ }
+
+ if (items < 3) {
+ value = NULL;
+ }
+ else {
+ value = (char *)SvPV_nolen(ST(2));
+ }
+
+ while (tree) {
+ directive = tree->directive;
+ directive_len = strlen(directive);
+
+ /* Remove starting '<' for container directives */
+ if (directive[0] == '<') {
+ directive++;
+ directive_len--;
+ }
+
+ if (0 == strncasecmp(directive, key, directive_len)) {
+
+ if (value) {
+ args = tree->args;
+ args_len = strlen(args);
+
+ /* Skip the postfix '>' */
+ if ('>' == args[args_len-1]) {
+ args_len--;
+ }
+
+ }
+
+ if ( (!value) || (0 == strncasecmp(args, value, args_len)) ) {
+ if (tree->first_child) {
+ XPUSHs(sv_2mortal(mpxs_Apache__Directive_as_hash(
+ aTHX_ tree->first_child)));
+ }
+ else {
+ XPUSHs(sv_2mortal(newSVpv(tree->args, 0)));
+ }
+
+ if (scalar_context) {
+ break;
+ }
+ }
+ }
+
+ tree = tree->next ? tree->next : NULL;
+ }
+ });
+}
1.52 +2 -0 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- modperl_functions.map 24 Jan 2003 07:39:29 -0000 1.51
+++ modperl_functions.map 29 Jan 2003 03:56:00 -0000 1.52
@@ -123,4 +123,6 @@
MODULE=Apache::Directive
mpxs_Apache__Directive_as_string
+ mpxs_Apache__Directive_as_hash
+ Apache__Directive_lookup | MPXS_ | ...
1.103 +31 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -r1.102 -r1.103
--- FunctionTable.pm 25 Jan 2003 03:08:05 -0000 1.102
+++ FunctionTable.pm 29 Jan 2003 03:56:00 -0000 1.103
@@ -3992,6 +3992,19 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'Apache__Directive_lookup',
+ 'attr' => [
+ 'static'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ ]
+ },
+ {
'return_type' => 'PerlInterpreter *',
'name' => 'modperl_startup',
'args' => [
@@ -4991,6 +5004,24 @@
{
'return_type' => 'SV *',
'name' => 'mpxs_Apache__Directive_as_string',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'ap_directive_t *',
+ 'name' => 'self'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_Apache__Directive_as_hash',
'attr' => [
'static',
'__inline__'
