Return-Path: Delivered-To: apmail-modperl-cvs-archive@apache.org Received: (qmail 87318 invoked by uid 500); 29 Jan 2003 03:56:02 -0000 Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Reply-To: dev@perl.apache.org Delivered-To: mailing list modperl-cvs@apache.org Received: (qmail 87278 invoked by uid 500); 29 Jan 2003 03:56:02 -0000 Delivered-To: apmail-modperl-2.0-cvs@apache.org Date: 29 Jan 2003 03:56:01 -0000 Message-ID: <20030129035601.64951.qmail@icarus.apache.org> From: stas@apache.org To: modperl-2.0-cvs@apache.org Subject: cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N 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 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 ] + 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__'