perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
Date Wed, 29 Jan 2003 03:56:01 GMT
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 <gozer@cpan.org>
  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 <gozer@cpan.org>]
  +
   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__'
  
  
  

Mime
View raw message