perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@hyperreal.org
Subject cvs commit: modperl/t/net/perl api.pl constants.pl
Date Sun, 10 May 1998 04:15:00 GMT
dougm       98/05/09 21:15:00

  Modified:    .        MANIFEST Makefile.PL ToDo
               Apache   typemap
               Constants Constants.pm
               lib/Apache ExtUtils.pm
               src/modules/perl Apache.xs Constants.xs Makefile mod_perl.h
                        perl_config.c perl_util.c
               t/TestDirectives Makefile.PL TestDirectives.pm
               t/conf   httpd.conf.pl
               t/docs   startup.pl
               t/internal http-get.t
               t/net/perl api.pl constants.pl
  Log:
  more Perl Directive Handler stuff
  -split out from dir_config to Apache::ModuleConfig->get
  -pass an Apache::CmdParms (cmd_parms*) object as first argument
  -more Apache::ExtUtils rope
  -if args_how is RAW_ARGS and the last arg in the Perl prototype is `*'
   pass a tie'd filehandle who's methods read out of the config file
  -better prototype checking
  -various cleanups/fixups
  
  Revision  Changes    Path
  1.13      +4 -0      modperl/MANIFEST
  
  Index: MANIFEST
  ===================================================================
  RCS file: /export/home/cvs/modperl/MANIFEST,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- MANIFEST	1998/05/08 02:40:44	1.12
  +++ MANIFEST	1998/05/10 04:14:48	1.13
  @@ -1,6 +1,8 @@
   Changes
   Constants/Constants.pm
   Constants/Makefile.PL
  +ModuleConfig/ModuleConfig.pm
  +ModuleConfig/Makefile.PL
   INSTALL
   SUPPORT
   INSTALL.win32
  @@ -48,6 +50,7 @@
   src/modules/perl/mod_perl_version.h
   src/modules/perl/Constants.xs
   src/modules/perl/Apache.xs
  +src/modules/perl/ModuleConfig.xs
   src/modules/perl/ldopts
   src/modules/perl/mod_perl.c
   src/modules/perl/mod_perl.h
  @@ -118,6 +121,7 @@
   t/net/perl/io/ssi1.pl
   t/net/perl/io/ssi2.pl
   t/net/perl/io/include.pl	
  +t/net/perl/io/dir_config.pl
   t/net/perl/noenv/test.pl
   lib/Apache/RedirectLogFix.pm
   lib/Apache/Include.pm
  
  
  
  1.25      +22 -7     modperl/Makefile.PL
  
  Index: Makefile.PL
  ===================================================================
  RCS file: /export/home/cvs/modperl/Makefile.PL,v
  retrieving revision 1.24
  retrieving revision 1.25
  diff -u -r1.24 -r1.25
  --- Makefile.PL	1998/05/08 02:40:44	1.24
  +++ Makefile.PL	1998/05/10 04:14:48	1.25
  @@ -138,7 +138,7 @@
   $DYNAMIC = 0;
   $CONFIG = "";
   $ADD_MODULE = "";
  -
  +$PERL_DIRECTIVE_HANDLERS = 0;
   my %experimental = map { $_,1 } qw{
   PERL_GET_SET_HANDLERS
   PERL_MARK_WHERE
  @@ -174,6 +174,7 @@
      PERL_INIT PERL_CLEANUP
      PERL_STACKED_HANDLERS 
      PERL_METHOD_HANDLERS
  +   PERL_DIRECTIVE_HANDLERS
   };
   
   $callback_alias{PERL_INIT} = "PERL_HEADER_PARSER";
  @@ -239,6 +240,13 @@
       }
   }
   
  +my @xs_modules = qw(Apache Apache::Constants);
  +if($PERL_DIRECTIVE_HANDLERS) {
  +    push @xs_modules, "Apache::ModuleConfig";
  +    $callback_hooks{PERL_DIRECTIVE_HANDLERS} = 1;
  +}
  +my @xs_mod_snames = map { (my $s = $_) =~ s/.*:://; $s } @xs_modules;
  +
   if($Is_Win32) {
       $NO_HTTPD = 1;
       win32_setup();
  @@ -413,7 +421,7 @@
   }
   
   if($DYNAMIC) {
  -    for (qw(Apache Constants)) {
  +    for (@xs_mod_snames) {
   	cp "src/modules/perl/${_}.xs", "${_}/${_}.xs" if $DYNAMIC;
       }
   }
  @@ -1060,7 +1068,7 @@
   
   sub cleanup_for_static {
       return unless $STATIC;
  -    for (qw(Apache Constants)) {
  +    for (@xs_mod_snames) {
   	rename "${_}/${_}.xs.disabled", "${_}/${_}.xs";
       }
   }
  @@ -1077,7 +1085,7 @@
   
       cp "Apache/typemap", $d;
   
  -    for (qw(Apache Constants)) {
  +    for (@xs_mod_snames) {
   	rename "${_}/${_}.xs", "${_}/${_}.xs.disabled" if -e "${_}/${_}.xs";
   	push @static_src, "$_.c";
       }
  @@ -1105,6 +1113,10 @@
       iedit $mf, "s/^#STATIC_EXTS.*/STATIC_EXTS = @xs_names/";
   =cut
   
  +    #XXX: ho,hum, need to generate the whole damn thing 
  +    #instead of all these frigging iedits.
  +    iedit $mf, "s/^#STATIC_SRC.*/STATIC_SRC = @static_src/";
  +    iedit $mf, "s/^#STATIC_EXTS.*/STATIC_EXTS = @xs_modules/";
       iedit $mf, "s/^#STATIC_/STATIC_/";
   
       #bloody hell, make sucks and so does this.
  @@ -1213,7 +1225,10 @@
   	if($repl =~ s/(\\)\s*$//) {
   	    $backwhack = $1;
   	}
  -
  +	my $mmn = magic_number($APACHE_SRC);
  +	if($mmn >= 19980507) {
  +	    $ADD_VERSION = 0;
  +	}
   	if($ADD_VERSION) {
   	    if(/$dssv=/) {
   		$repl =~ 
  @@ -1345,9 +1360,9 @@
       dirent_kludge($d);
       cp "Apache/typemap", $d;
       chdir $d;
  -    system "$^X -MExtUtils::Embed -e xsinit -- -std Apache Apache::Constants $PERL_STATIC_EXTS";
  +    system "$^X -MExtUtils::Embed -e xsinit -- -std @xs_modules $PERL_STATIC_EXTS";
       my $lib = $Config{privlibexp};
  -    for (qw(Constants Apache)) {    
  +    for (@xs_mod_snames) {    
           system "$^X $lib/ExtUtils/xsubpp -typemap $lib/ExtUtils/typemap $_.xs > $_.c";
   
       }
  
  
  
  1.19      +8 -1      modperl/ToDo
  
  Index: ToDo
  ===================================================================
  RCS file: /export/home/cvs/modperl/ToDo,v
  retrieving revision 1.18
  retrieving revision 1.19
  diff -u -r1.18 -r1.19
  --- ToDo	1998/05/08 02:40:45	1.18
  +++ ToDo	1998/05/10 04:14:49	1.19
  @@ -16,6 +16,11 @@
                    (well, close to it anyhow)
   ---------------------------------------------------------------------------
   
  +- make sure SERVER_VERSION/SERVER_SUBVERSION, etc. is in sync w/ 1.3b7 changes
  +- get rid of Cwd::fastcwd() usage
  +- get rid of IO::File usage, replace with Apache::gensym
  +- add chdir_file to replace chdir File::Basename::dirname
  +
   - perl-status?mod_perl_hooks broken under win32?
   
   - documentation:
  @@ -43,12 +48,14 @@
            Ed Jordan <ed@fidalgo.net>
   
   ---------------------------------------------------------------------------
  -DOCUMENTATION (areas that *really* need some)
  +DOCUMENTATION (areas that *really* need some more or don't have any)
   ---------------------------------------------------------------------------
   
   - HTTP Headers!!!!
   
   - Apache::exit/child_terminate
  +
  +- push_handlers/set_handlers
   
   ---------------------------------------------------------------------------
   KNOWN BUGS
  
  
  
  1.4       +1 -0      modperl/Apache/typemap
  
  Index: typemap
  ===================================================================
  RCS file: /export/home/cvs/modperl/Apache/typemap,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- typemap	1998/04/30 03:13:14	1.3
  +++ typemap	1998/05/10 04:14:51	1.4
  @@ -1,5 +1,6 @@
   TYPEMAP
   Apache			T_APACHEOBJ
  +Apache::CmdParms	T_PTROBJ
   Apache::SubRequest	T_PTROBJ
   Apache::Connection	T_PTROBJ
   Apache::Server		T_PTROBJ
  
  
  
  1.6       +3 -0      modperl/Constants/Constants.pm
  
  Index: Constants.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/Constants/Constants.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- Constants.pm	1998/03/19 23:08:28	1.5
  +++ Constants.pm	1998/05/10 04:14:51	1.6
  @@ -47,11 +47,13 @@
   		     HTTP_PRECONDITION_FAILED
   		     HTTP_SERVICE_UNAVAILABLE
   		     HTTP_VARIANT_ALSO_VARIES);
  +my(@config)     = qw(DECLINE_CMD);
   
   my $rc = [@common, @response];
   
   %Apache::Constants::EXPORT_TAGS = (
       common     => \@common,
  +    config     => \@config,
       response   => $rc,
       http       => \@http,
       options    => \@options,
  @@ -71,6 +73,7 @@
       @remotehost,
       @satisfy,
       @server,
  +    @config,
   ); 
      
   *Apache::Constants::EXPORT = \@common;
  
  
  
  1.8       +83 -30    modperl/lib/Apache/ExtUtils.pm
  
  Index: ExtUtils.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/lib/Apache/ExtUtils.pm,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -r1.7 -r1.8
  --- ExtUtils.pm	1998/05/04 02:19:00	1.7
  +++ ExtUtils.pm	1998/05/10 04:14:52	1.8
  @@ -9,13 +9,27 @@
   @Apache::ExtUtils::EXPORT = qw(command_table);
   
   sub command_table {
  -    my($class, $cmds) = @_;
  +    my($class, $cmds);
  +    if(@_ == 2) {
  +	($class, $cmds) = @_;
  +    }
  +    else {
  +	$cmds = shift;
  +	$class = caller;
  +    }
       (my $file = $class) =~ s,.*::,,;
   
       eval {
   	require "$file.pm"; #so we can see prototypes
       };
  -
  +    if ($@) {
  +	require ExtUtils::testlib;
  +        ExtUtils::testlib->import;
  +	require lib;
  +	my $lib = "lib";#hmm, lib->import + -w == Unquoted string "lib" ...
  +	$lib->import('./lib');
  +	require $class;
  +    }
       unless (-e "$file.xs.orig") {
           File::Copy::cp("$file.xs", "$file.xs.orig");
       }
  @@ -26,19 +40,19 @@
       close $fh;
   }
   
  -#the first `$' is for the config object
  +#the first two `$$' are for the parms object and per-directory object
   my $proto_perl2c = {
  -    '$$$$'  => "TAKE3",
  -    '$$$'   => "TAKE2",
  -    '$$'    => "TAKE1",
  -    '$'     => "NO_ARGS",
  -    ''      => "NO_ARGS",
  -    '$$;$'  => "TAKE12",
  -    '$$$;$' => "TAKE23",
  -    '$$;$$' => "TAKE123",
  -    '$@'    => "ITERATE",
  -    '$@;@'  => "ITERATE2",
  -    '$$;*'  => "RAW_ARGS",
  +    '$$$$$'  => "TAKE3",
  +    '$$$$'   => "TAKE2",
  +    '$$$'    => "TAKE1",
  +    '$$'     => "NO_ARGS",
  +    ''       => "NO_ARGS",
  +    '$$$;$'  => "TAKE12",
  +    '$$$$;$' => "TAKE23",
  +    '$$$;$$' => "TAKE123",
  +    '$$@'    => "ITERATE",
  +    '$$@;@'  => "ITERATE2",
  +    '$$$;*'  => "RAW_ARGS",
   };
   
   my $proto_c2perl = {
  @@ -48,56 +62,94 @@
   sub proto_perl2c { $proto_perl2c }
   sub proto_c2perl { $proto_c2perl }
   
  +sub cmd_info {
  +    my($name, $subname, $info, $args_how) = @_;
  +    return <<EOF;
  +static mod_perl_cmd_info cmd_info_$name = { 
  +"$subname", "$info", 
  +};
  +EOF
  +}
  +
   sub xs_cmd_table {
       my($self, $class, $cmds) = @_;
       (my $modname = $class) =~ s/::/__/g;
       my $cmdtab = "";
  +    my $infos = "";
   
       for my $cmd (@$cmds) {
  -	my($name, $proto, $desc);
  -
  +	my($name, $sub, $cmd_data, $req_override, $args_how, $proto, $desc);
  +	my $hash;
   	if(ref($cmd) eq "ARRAY") {
   	    ($name,$desc) = @$cmd;
   	}
  +	elsif(ref($cmd) eq "HASH") {
  +	    $name = $cmd->{name};
  +	    $sub = $cmd->{func};
  +	    $sub = join '::', $class, $cmd->{func} unless defined &$sub;
  +	    $cmd_data = $cmd->{cmd_data};
  +	    $req_override = $cmd->{req_override};
  +	    $desc = $cmd->{errmsg};
  +	    $args_how = $cmd->{args_how};
  +	}
   	else {
   	    $name = $cmd;
   	}
  +	$name ||= $sub;
   	my $realname = $name;
   	if($name =~ s/[\<\>]//g) {
   	    if($name =~ s:^/::) {
   		$name .= "_END";
   	    }
   	}
  -	my $sub = join '::', $class, $name;
  -	my $meth = $class->can($name);
  -	my $take = "TAKE123";
  -	if($meth || defined(&$sub)) {
  +	$sub ||= join '::', $class, $name;
  +	$req_override ||= "OR_ALL";
  +	my $meth = $class->can($name) if $name;
  +
  +	if(not $args_how and ($meth || defined(&$sub))) {
   	    if(defined($proto = prototype($meth || \&{$sub}))) {
   		#extra $ is for config data
  -		$take = $proto_perl2c->{$proto};
  +		$args_how = $proto_perl2c->{$proto};
  +	    }
  +	    else {
  +		$args_how ||= "TAKE123";
   	    }
   	}
   	$desc ||= "1-3 value(s) for $name";
   
  +	(my $cname = $name) =~ s/\W/_/g;
  +	$infos .= cmd_info($cname, $sub, $cmd_data, $args_how);
   	$cmdtab .= <<EOF;
   
  -    { "$realname", perl_cmd_perl_$take,
  -      (void*)"$sub",
  -      OR_ALL, $take, "$desc" },
  +    { "$realname", perl_cmd_perl_$args_how,
  +      (void*)&cmd_info_$cname,
  +      $req_override, $args_how, "$desc" },
   EOF
       }
   
       return <<EOF;
   #include "modules/perl/mod_perl.h"
  +
  +static mod_perl_perl_dir_config *newPerlConfig(pool *p)
  +{
  +    mod_perl_perl_dir_config *cld =
  +	(mod_perl_perl_dir_config *)
  +	    palloc(p, sizeof (mod_perl_perl_dir_config));
  +    cld->obj = Nullsv;
  +    cld->class = NULL;
  +    return cld;
  +}
   
  -static SV *DirSV;
   static void *create_dir_config_sv (pool *p, char *dirname)
   {
  -    SV *sv = newSV(TRUE);
  -    DirSV = sv;
  -    return &DirSV;
  +    return newPerlConfig(p);
   }
   
  +static void *create_srv_config_sv (pool *p, server_rec *s)
  +{
  +    return newPerlConfig(p);
  +}
  +
   static void stash_mod_pointer (char *class, void *ptr)
   {
       SV *sv = newSV(0);
  @@ -106,6 +158,8 @@
   	     class, strlen(class), sv, FALSE);
   }
   
  +$infos
  +
   static command_rec mod_cmds[] = {
       $cmdtab
       { NULL }
  @@ -116,7 +170,7 @@
       NULL,               /* module initializer */
       create_dir_config_sv,  /* per-directory config creator */
       NULL,   /* dir config merger */
  -    NULL,       /* server config creator */
  +    create_srv_config_sv,       /* server config creator */
       NULL,        /* server config merger */
       mod_cmds,               /* command table */
       NULL,           /* [7] list of handlers */
  @@ -138,7 +192,6 @@
   BOOT:
       add_module(&XS_${modname});
       stash_mod_pointer("$class", &XS_${modname});
  -    av_push(perl_get_av("$class\:\:ISA",TRUE), newSVpv("Apache::Config",0));
   
   EOF
   }
  
  
  
  1.21      +4 -80     modperl/src/modules/perl/Apache.xs
  
  Index: Apache.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
  retrieving revision 1.20
  retrieving revision 1.21
  diff -u -r1.20 -r1.21
  --- Apache.xs	1998/05/08 02:40:48	1.20
  +++ Apache.xs	1998/05/10 04:14:52	1.21
  @@ -274,12 +274,6 @@
   int basic_http_header(request_rec *r);
   #endif
   
  -#if MODULE_MAGIC_NUMBER > 19970912 
  -#define cmd_infile   parms->config_file
  -#else
  -#define cmd_infile   parms->infile
  -#endif
  -
   pool *perl_get_startup_pool(void)
   {
       SV *sv = perl_get_sv("Apache::__POOL", FALSE);
  @@ -300,16 +294,6 @@
       return NULL;
   }
   
  -static cmd_parms *perl_get_cmd_parms(void)
  -{
  -    SV *sv = perl_get_sv("Apache::__CMDPARMS", FALSE);
  -    if(sv) {
  -	IV tmp = SvIV((SV*)SvRV(sv));
  -	return (cmd_parms *)tmp;
  -    }
  -    return NULL;
  -}
  -
   #if MODULE_MAGIC_NUMBER > 19970909
   static int mp_get_basic_auth_pw(request_rec *r, char **pw)
   {
  @@ -1806,42 +1790,17 @@
   #  void *per_dir_config;		/* Options set in config files, etc. */
   
   SV *
  -dir_config(r, svkey=Nullsv, ...)
  +dir_config(r, key, ...)
       Apache  r
  -    SV *svkey
  +    char *key
   
       PREINIT:
       perl_dir_config *c;
  -    SV *caller = Nullsv;
   
       CODE:
  -    if(svkey && (gv_stashpv(SvPV(svkey,na), FALSE)))
  -        caller = svkey;
  +    c = get_module_config(r->per_dir_config, &perl_module);
  +    TABLE_GET_SET(c->vars, FALSE);
   
  -    if((svkey == Nullsv) || caller) {
  -	HV *xs_config = perl_get_hv("Apache::XS_ModuleConfig", TRUE);
  -	SV **mod_ptr;
  -	RETVAL = Nullsv;
  -
  -	if(!caller)
  -	    caller = perl_eval_pv("scalar caller", TRUE);
  -
  -	if(caller) 
  -	    mod_ptr = hv_fetch(xs_config, SvPVX(caller), SvCUR(caller), FALSE);
  -
  -	if(mod_ptr && *mod_ptr) {
  -	    IV tmp = SvIV((SV*)SvRV(*mod_ptr));
  -	    SV **data = get_module_config(r->per_dir_config, (module *)tmp);
  -	    RETVAL = data ? SvREFCNT_inc(*data) : Nullsv; 
  -	}
  -	if(!RETVAL) XSRETURN_UNDEF;
  -    }
  -    else {
  -	char *key = SvPV(svkey,na);
  -        c = get_module_config(r->per_dir_config, &perl_module);
  -        TABLE_GET_SET(c->vars, FALSE);
  -    }
  -
       OUTPUT:
       RETVAL
      
  @@ -2135,38 +2094,3 @@
   
       OUTPUT:
       RETVAL				   
  -
  -MODULE = Apache  PACKAGE = Apache::Config
  -
  -char *
  -getline(self)
  -    SV *self
  -
  -    PREINIT:
  -    cmd_parms *parms = perl_get_cmd_parms();
  -    char l[MAX_STRING_LEN];
  -
  -    CODE:				   
  -    if(!parms) XSRETURN_UNDEF;
  -
  -    (void)cfg_getline(l, MAX_STRING_LEN, cmd_infile);
  -    RETVAL = l;
  -
  -    OUTPUT:
  -    RETVAL
  -
  -char *
  -path(self)
  -    SV *self
  -
  -    PREINIT:
  -    cmd_parms *parms = perl_get_cmd_parms();
  -
  -    CODE:				   
  -    if(!parms) XSRETURN_UNDEF;
  -
  -    RETVAL = parms->path;
  -
  -    OUTPUT:
  -    RETVAL
  -
  
  
  
  1.5       +10 -0     modperl/src/modules/perl/Constants.xs
  
  Index: Constants.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Constants.xs,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- Constants.xs	1998/03/19 23:08:52	1.4
  +++ Constants.xs	1998/05/10 04:14:53	1.5
  @@ -825,3 +825,13 @@
      OUTPUT:
      RETVAL
   
  +char *
  +DECLINE_CMD()
  +   CODE:
  +#ifdef DECLINE_CMD
  +    RETVAL = DECLINE_CMD;
  +#else
  +    RETVAL = "\a\b";
  +#endif
  +   OUTPUT:
  +   RETVAL
  
  
  
  1.7       +4 -2      modperl/src/modules/perl/Makefile
  
  Index: Makefile
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Makefile,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- Makefile	1998/03/19 23:08:53	1.6
  +++ Makefile	1998/05/10 04:14:53	1.7
  @@ -50,7 +50,7 @@
   # 
   # Makefile for the Apache mod_perl library
   # 
  -# $Id: Makefile,v 1.6 1998/03/19 23:08:53 dougm Exp $
  +# $Id: Makefile,v 1.7 1998/05/10 04:14:53 dougm Exp $
   #
   
   #__ORIGINAL__
  @@ -83,6 +83,7 @@
   PERL_STACKED_HANDLERS = -DNO_PERL_STACKED_HANDLERS
   PERL_SECTIONS         = -DNO_PERL_SECTIONS
   PERL_METHOD_HANDLERS  = -DNO_PERL_METHOD_HANDLERS
  +PERL_DIRECTIVE_HANDLERS  = -DNO_PERL_DIRECTIVE_HANDLERS
   PERL_SSI = -DNO_PERL_SSI
   
   PERL_HOOKS =   $(PERL_DISPATCH) $(PERL_CHILD_INIT) $(PERL_CHILD_EXIT) \
  @@ -90,7 +91,8 @@
    $(PERL_ACCESS) $(PERL_AUTHEN) $(PERL_AUTHZ) \
    $(PERL_TYPE) $(PERL_FIXUP) $(PERL_LOG) \
    $(PERL_INIT) $(PERL_CLEANUP) $(PERL_RESTART) \
  - $(PERL_STACKED_HANDLERS) $(PERL_SECTIONS) $(PERL_METHOD_HANDLERS) $(PERL_SSI)
  + $(PERL_STACKED_HANDLERS) $(PERL_SECTIONS) $(PERL_METHOD_HANDLERS) \
  + $(PERL_SSI) $(PERL_DIRECTIVE_HANDLERS)
   
   #STATIC_SRC = Apache.c Constants.c
   #STATIC_EXTS = Apache Apache::Constants
  
  
  
  1.20      +28 -3     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.19
  retrieving revision 1.20
  diff -u -r1.19 -r1.20
  --- mod_perl.h	1998/05/08 02:40:49	1.19
  +++ mod_perl.h	1998/05/10 04:14:53	1.20
  @@ -126,6 +126,7 @@
   typedef request_rec * Apache__SubRequest;
   typedef conn_rec    * Apache__Connection;
   typedef server_rec  * Apache__Server;
  +typedef cmd_parms   * Apache__CmdParms;
   
   #define GvHV_init(name) gv_fetchpv(name, GV_ADDMULTI, SVt_PVHV)
   #define GvSV_init(name) gv_fetchpv(name, GV_ADDMULTI, SVt_PV)
  @@ -271,6 +272,9 @@
   #define PERL_APACHE_SSI_TYPE "text/x-perl-server-parsed-html"
   /* PerlSetVar */
   
  +#ifndef NO_PERL_DIRECTIVE_HANDLERS
  +#define PERL_DIRECTIVE_HANDLERS
  +#endif
   #ifndef NO_PERL_STACKED_HANDLERS
   #define PERL_STACKED_HANDLERS
   #endif
  @@ -294,6 +298,16 @@
   /* some 1.2.x/1.3.x compat stuff */
   /* once 1.3.0 is here, we can toss most of this junk */
   
  +#if MODULE_MAGIC_NUMBER > 19970912 
  +#define cmd_infile   parms->config_file
  +#define cmd_filename parms->config_file->name
  +#define cmd_linenum  parms->config_file->line_number
  +#else
  +#define cmd_infile   parms->infile
  +#define cmd_filename parms->config_file
  +#define cmd_linenum  parms->config_line
  +#endif
  +
   #ifndef DONE
   #define DONE -2
   #endif
  @@ -795,6 +809,16 @@
       char *method;
   } mod_perl_handler;
   
  +typedef struct {
  +    SV *obj;
  +    char *class;
  +} mod_perl_perl_dir_config;
  +
  +typedef struct {
  +    char *subname;
  +    char *info;
  +} mod_perl_cmd_info;
  +
   extern module MODULE_VAR_EXPORT perl_module;
   
   /* a couple for -Wall sanity sake */
  @@ -855,6 +879,7 @@
   
   SV *array_header2avrv(array_header *arr);
   array_header *avrv2array_header(SV *avrv, pool *p);
  +SV *mod_perl_gensym (char *pack);
   void perl_tie_hash(HV *hv, char *class);
   void perl_util_cleanup(void);
   void mod_perl_clear_rgy_endav(request_rec *r, SV *sv);
  @@ -933,9 +958,9 @@
   CHAR_P perl_cmd_fixup_handlers (cmd_parms *parms, perl_dir_config *rec, char *arg);
   CHAR_P perl_cmd_handler_handlers (cmd_parms *parms, perl_dir_config *rec, char *arg);
   CHAR_P perl_cmd_log_handlers (cmd_parms *parms, perl_dir_config *rec, char *arg);
  -CHAR_P perl_cmd_perl_TAKE1(cmd_parms *cmd, SV **data, char *one);
  -CHAR_P perl_cmd_perl_TAKE2(cmd_parms *cmd, SV **data, char *one, char *two);
  -CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, SV **config,
  +CHAR_P perl_cmd_perl_TAKE1(cmd_parms *cmd, mod_perl_perl_dir_config *d, char *one);
  +CHAR_P perl_cmd_perl_TAKE2(cmd_parms *cmd, mod_perl_perl_dir_config *d, char *one, char
*two);
  +CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, mod_perl_perl_dir_config *d,
   			     char *one, char *two, char *three);
   
   #define perl_cmd_perl_RAW_ARGS perl_cmd_perl_TAKE1
  
  
  
  1.16      +34 -24    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.15
  retrieving revision 1.16
  diff -u -r1.15 -r1.16
  --- perl_config.c	1998/05/08 02:40:49	1.15
  +++ perl_config.c	1998/05/10 04:14:53	1.16
  @@ -55,16 +55,6 @@
   
   extern API_VAR_EXPORT module *top_module;
   
  -#if MODULE_MAGIC_NUMBER > 19970912 
  -#define cmd_infile   parms->config_file
  -#define cmd_filename parms->config_file->name
  -#define cmd_linenum  parms->config_file->line_number
  -#else
  -#define cmd_infile   parms->infile
  -#define cmd_filename parms->config_file
  -#define cmd_linenum  parms->config_line
  -#endif
  -
   #ifdef PERL_SECTIONS
   static int perl_sections_self_boot = 0;
   static const char *perl_sections_boot_module = NULL;
  @@ -618,23 +608,34 @@
   CHAR_P perl_pod_end_section (cmd_parms *cmd, void *dummy) {
       return perl_pod_end_magic;
   }
  +
  +#ifdef PERL_DIRECTIVE_HANDLERS
   
  -CHAR_P perl_cmd_perl_TAKE1(cmd_parms *cmd, SV **data, char *one)
  +CHAR_P perl_cmd_perl_TAKE1(cmd_parms *cmd, mod_perl_perl_dir_config *data, char *one)
   {
       return perl_cmd_perl_TAKE123(cmd, data, one, NULL, NULL);
   }
   
  -CHAR_P perl_cmd_perl_TAKE2(cmd_parms *cmd, SV **data, char *one, char *two)
  +CHAR_P perl_cmd_perl_TAKE2(cmd_parms *cmd, mod_perl_perl_dir_config *data, char *one, char
*two)
   {
       return perl_cmd_perl_TAKE123(cmd, data, one, two, NULL);
   }
   
  +
  +static SV *perl_bless_cmd_parms(cmd_parms *parms)
  +{
  +    SV *sv = sv_newmortal();
  +    sv_setref_pv(sv, "Apache::CmdParms", (void*)parms);
  +    MP_TRACE_g(fprintf(stderr, "blessing cmd_parms=(0x%lx)\n",
  +		     (unsigned long)parms));
  +    return sv;
  +}
   
  -static SV *perl_perl_create_dir_config(SV **sv, HV *class)
  +static SV *perl_perl_create_dir_config(SV **sv, HV *class, cmd_parms *parms)
   {
       GV *gv; 
   
  -    if(SvTRUE(*sv) && SvROK(*sv) && sv_isobject(*sv))
  +    if(*sv && SvTRUE(*sv) && SvROK(*sv) && sv_isobject(*sv))
   	return *sv;
   
       /* return $class->new if $class->can("new") */
  @@ -645,10 +646,11 @@
   	ENTER;SAVETMPS;
   	PUSHMARK(sp);
   	XPUSHs(sv_2mortal(newSVpv(HvNAME(class),0)));
  +	XPUSHs(perl_bless_cmd_parms(parms));
   	PUTBACK;
   	count = perl_call_sv((SV*)GvCV(gv), G_EVAL | G_SCALAR);
   	SPAGAIN;
  -	if(count == 1) {
  +	if((perl_eval_ok(parms->server) == OK) && (count == 1)) {
   	    *sv = POPs;
   	    ++SvREFCNT(*sv);
   	}
  @@ -667,35 +669,42 @@
       }
   }
   
  -CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, SV **data,
  +CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, mod_perl_perl_dir_config *data,
   				  char *one, char *two, char *three)
   {
       dSP;
  -    char *subname = (char *)cmd->info;
  +    mod_perl_cmd_info *info = (mod_perl_cmd_info *)cmd->info;
  +    char *subname = info->subname;
       int count = 0;
       CV *cv = perl_get_cv(subname, TRUE);
       SV *obj;
  -    SV *sv = perl_get_sv("Apache::__CMDPARMS", TRUE);
  -    sv_setref_pv(sv, "Apache::Config", (void*)cmd);
  +    bool has_empty_proto = (SvPOK(cv) && (SvLEN(cv) == 1));
   
  -    obj = perl_perl_create_dir_config(data, CvSTASH(cv));
  +    obj = perl_perl_create_dir_config(&data->obj, CvSTASH(cv), cmd);
   
       ENTER;SAVETMPS;
       PUSHMARK(sp);
  -    if(SvPOK(cv) && (SvCUR(cv) || (SvPVX(cv) == NULL))) {
  +    if(!has_empty_proto) {
  +	SV *cmd_obj = perl_bless_cmd_parms(cmd);
  +	XPUSHs(cmd_obj);
   	XPUSHs(obj);
  -	PUSHif(one);PUSHif(two);PUSHif(three);
  +	if(cmd->cmd->args_how != NO_ARGS) {
  +	    PUSHif(one);PUSHif(two);PUSHif(three);
  +	}
  +	if(SvPOK(cv) && (*(SvEND((SV*)cv)-1) == '*')) {
  +	    SV *gp = mod_perl_gensym("Apache::CmdParms");
  +	    sv_magic((SV*)SvRV(gp), cmd_obj, 'q', Nullch, 0); 
  +	    XPUSHs(gp);
  +	}
       }
       PUTBACK;
       count = perl_call_sv((SV*)cv, G_EVAL | G_SCALAR);
       SPAGAIN;
  -#if 1
       if(count == 1) {
   	char *retval = POPp;
   	if(strEQ(retval, DECLINE_CMD))
   	    return DECLINE_CMD;
       }
  -#endif
       FREETMPS;LEAVE;
   
       if(SvTRUE(ERRSV))
  @@ -703,6 +712,7 @@
       else
   	return NULL;
   }
  +#endif /* PERL_DIRECTIVE_HANDLERS */
   
   #ifdef PERL_SECTIONS
   
  
  
  
  1.6       +10 -0     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.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- perl_util.c	1998/03/19 23:08:57	1.5
  +++ perl_util.c	1998/05/10 04:14:54	1.6
  @@ -93,6 +93,16 @@
       return arr;
   }
   
  +/* same as Symbol::gensym() */
  +SV *mod_perl_gensym (char *pack)
  +{
  +    GV *gv = newGVgen(pack);
  +    SV *rv = newRV((SV*)gv);
  +    (void)hv_delete(gv_stashpv(pack, TRUE), 
  +		    GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
  +    return rv;
  +}
  +
   #ifdef PERL_SECTIONS
   void perl_tie_hash(HV *hv, char *class)
   {
  
  
  
  1.5       +13 -3     modperl/t/TestDirectives/Makefile.PL
  
  Index: Makefile.PL
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/TestDirectives/Makefile.PL,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- Makefile.PL	1998/04/30 12:06:34	1.4
  +++ Makefile.PL	1998/05/10 04:14:56	1.5
  @@ -1,3 +1,4 @@
  +package Apache::TestDirectives;
   use ExtUtils::MakeMaker;
   # See lib/ExtUtils/MakeMaker.pm for details of how to influence
   # the contents of the Makefile that is written.
  @@ -10,24 +11,33 @@
   use Apache::src ();
   use Apache::ExtUtils qw(command_table);
   
  -my $class = 'Apache::TestDirectives';
  +my $class = __PACKAGE__;
   
   my @directives = (
  +   [Port => "A TCP port number"], #we'll decline this one
      [TestCmd => "Two TestCmd args"],
      [AnotherCmd => "Stuff for another command"],
  -   [YAC => "Yet another comand"],
      [CmdIterate => "No limit here"],
      ["<Container" => "whatever"],
      ["</Container>" => "end whatever"],
  +   {
  +       name => "YAC",
  +       func => "another_cmd",
  +       cmd_data => "info for YAC",
  +       errmsg => "Yet another comand",
  +       args_how => "TAKE2",
  +       req_override => "OR_ALL",
  +   },
   );
   
   my $proto_perl2c = Apache::ExtUtils->proto_perl2c;
   
   while(my($pp,$cp) = each %$proto_perl2c) {
  +    next unless $pp;
       push @directives, [$cp, "Test for $cp"];
   }
   
  -command_table $class, \@directives;
  +command_table \@directives;
   
   WriteMakefile(
       'NAME'	=> $class,
  
  
  
  1.7       +37 -19    modperl/t/TestDirectives/TestDirectives.pm
  
  Index: TestDirectives.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/TestDirectives/TestDirectives.pm,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- TestDirectives.pm	1998/05/04 04:09:17	1.6
  +++ TestDirectives.pm	1998/05/10 04:14:56	1.7
  @@ -4,7 +4,12 @@
   use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
   
   use DynaLoader (); 
  +use Apache::Constants ();
  +*DECLINE_CMD = \&Apache::Constants::DECLINE_CMD;
   
  +eval {
  +  require Apache::ModuleConfig;
  +};
   use Data::Dumper 'Dumper';
   
   @ISA = qw(DynaLoader TestDirectives::Base);
  @@ -20,35 +25,44 @@
       $self->{$k} = $v;
   }
   
  -sub TestCmd ($$$) {
  -    my($cfg, $one, $two) = @_;
  +sub Port ($$$) {
  +    my($parms, $cfg, $port) = @_;
  +    warn "Port will be $port\n";
  +    return DECLINE_CMD();
  +}
  +
  +sub TestCmd ($$$$) {
  +    my($parms, $cfg, $one, $two) = @_;
       #warn "TestCmd called with args: `$one', `$two'\n";
       $cfg->attr(TestCmd => [$one,$two]);
  +    $parms->server->isa("Apache::Server") or die "parms->server busted";
  +    my $or = $parms->override;
  +    my $limit = $parms->limited;
       #warn Dumper($cfg), $/;
   }
   
  -sub AnotherCmd {
  -    my($cfg, @data) = @_;
  -    $cfg->{AnotherCmd} = [@data];
  -    #warn Dumper($cfg), $/;
  -    $cfg->{YAC} = [@data];
  +sub AnotherCmd () {
  +    die "prototype check broken [@_]" if @_ > 0;
   }
   
  -sub CmdIterate ($@) {
  -    my($cfg, @data) = @_;
  -    #warn "$cfg->ITERATE: @data\n";
  +sub CmdIterate ($$@) {
  +    my($parms, $cfg, @data) = @_;
  +    $cfg->{CmdIterate} = [@data];
  +    $cfg->{path} = $parms->path;
   }
   
  -sub YAC {
  -    my($cfg, @data) = @_;
  -    #warn Dumper($cfg), $/;
  +sub another_cmd {
  +    my($parms, $cfg, @data) = @_;
  +    $parms->info =~ /YAC/ or die "parms->info busted";
  +    $cfg->{parms_info_from_another_cmd} = $parms->info;
   }
   
  -sub Container ($$;*) {
  -    my($cfg, $arg) = @_;
  +sub Container ($$$;*) {
  +    my($parms, $cfg, $arg, $fh) = @_;
       $arg =~ s/>//;
       warn "ARG=$arg\n";
  -    while(my($line) = $cfg->getline) {
  +    #while($parms->getline($line)) {
  +    while(defined(my $line = <$fh>)) {
   	last if $line =~ m:</Container>:i;
   	warn "LINE=`$line'\n";
       }
  @@ -67,7 +81,8 @@
       $code .= <<SUB;
   sub $cp ($pp) { 
       warn "$cp called with args: ", (map "`\$_', ", \@_), "\n";
  -    shift->attr($cp => [\@_]);
  +    my(\$parms, \$cfg, \@args) = \@_;
  +    \$cfg->attr($cp => [\@args]) if ref(\$cfg);
   }
   SUB
   }
  @@ -77,8 +92,11 @@
   package TestDirectives::Base;
   
   sub new {
  -    my $class = shift;
  -    return bless {FromNew => __PACKAGE__}, $class;
  +    my($class, $parms) = @_;
  +    return bless {
  +	FromNew => __PACKAGE__,
  +	path => $parms->path || "",
  +    }, $class;
   }
   
   # Preloaded methods go here.
  
  
  
  1.10      +8 -2      modperl/t/conf/httpd.conf.pl
  
  Index: httpd.conf.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/conf/httpd.conf.pl,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- httpd.conf.pl	1998/04/30 12:06:35	1.9
  +++ httpd.conf.pl	1998/05/10 04:14:57	1.10
  @@ -36,18 +36,20 @@
    
       my $proto_perl2c = Apache::ExtUtils->proto_perl2c;
   
  +    $PerlConfig .= "<Location /perl>\n";
       while(my($pp,$cp) = each %$proto_perl2c) {
   	my $arg = "A";
  -	$pp =~ s/^\$//;
  +	$pp =~ s/^\$\$//;
   	1 while $pp =~ s/(\$|\@)/$arg++ . " "/ge;
   	$PerlConfig .= "$cp $pp\n";
       }
   
       $PerlConfig .= <<EOF;
   TestCmd one two
  -AnotherCmd uno dos tres
  +AnotherCmd
   CmdIterate A B C D E F
   YAC yet another
  +</Location>
   <Container /for/whatever>
   
   it's  
  @@ -55,6 +57,10 @@
   time
   #make that a scotch
   </Container>
  +
  +<Location /perl/io>
  +TestCmd PerlIO IsStdio
  +</Location>
   EOF
   }
   
  
  
  
  1.9       +0 -1      modperl/t/docs/startup.pl
  
  Index: startup.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/docs/startup.pl,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- startup.pl	1998/05/08 02:40:51	1.8
  +++ startup.pl	1998/05/10 04:14:58	1.9
  @@ -31,7 +31,6 @@
   #warn "ServerReStarting=$Apache::ServerReStarting\n";
   
   #use Apache::Debug level => 4;
  -
   use mod_perl 1.03_01;
   
   if(defined &main::subversion) {
  
  
  
  1.3       +4 -1      modperl/t/internal/http-get.t
  
  Index: http-get.t
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/internal/http-get.t,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- http-get.t	1998/04/23 05:14:43	1.2
  +++ http-get.t	1998/05/10 04:14:58	1.3
  @@ -3,7 +3,7 @@
   # Check GET via HTTP.
   #
   
  -my $num_tests = 8;
  +my $num_tests = 9;
   my(@test_scripts) = qw(test perl-status);
   %get_only = map { $_,1 } qw(perl-status);
   
  @@ -44,6 +44,9 @@
       test ++$i, ($str =~ /^REQUEST_METHOD=GET$/m); 
       test ++$i, ($str =~ /^QUERY_STRING=query$/m); 
   }
  +
  +test ++$i, $response->header("Server") =~ /mod_perl/;
  +print "Server: ", $response->header("Server"), "\n";
   
   #test PerlSetupEnv Off
   test ++$i, fetch("/perl/noenv/test.pl") !~ /SERVER_SOFTWARE/m;
  
  
  
  1.11      +8 -7      modperl/t/net/perl/api.pl
  
  Index: api.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- api.pl	1998/05/04 04:09:18	1.10
  +++ api.pl	1998/05/10 04:14:59	1.11
  @@ -15,10 +15,10 @@
   
   %ENV = $r->cgi_env;
   
  -my $tests = 39;
  +my $tests = 38;
   my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
   my $test_custom_response = (MODULE_MAGIC_NUMBER >= 19980324) && $tests++;
  -my $test_dir_config = $INC{'Apache/TestDirectives.pm'} && ($tests += 6);
  +my $test_dir_config = $INC{'Apache/TestDirectives.pm'} && ($tests += 7);
   
   my $i;
   
  @@ -124,17 +124,18 @@
       test ++$i, @$handlers == 0;
   }
   
  -my $dc = $r->dir_config;
  -test ++$i, not $dc;
  -
   if($test_dir_config) {
  +    require Apache::ModuleConfig;
  +    my $dc = Apache::ModuleConfig->get($r);
  +    test ++$i, not $dc;
  +
       for my $cv (
   		sub {
   		    package Apache::TestDirectives;
  -		    Apache->request->dir_config;
  +		    Apache::ModuleConfig->get(Apache->request);
   		},
                   sub {
  -		    $r->dir_config("Apache::TestDirectives");
  +		    Apache::ModuleConfig->get($r, "Apache::TestDirectives");
   		})
       {
           my $cfg = $cv->();
  
  
  
  1.4       +1 -1      modperl/t/net/perl/constants.pl
  
  Index: constants.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/constants.pl,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- constants.pl	1998/02/21 13:51:28	1.3
  +++ constants.pl	1998/05/10 04:14:59	1.4
  @@ -28,7 +28,7 @@
   push @export, grep {!$SEEN{$_}++} @Apache::Constants::EXPORT;
   
   #skip some 1.3 stuff that 1.2 didn't have
  -my %skip = map { $_,1 } qw(DONE REMOTE_DOUBLE_REV 
  +my %skip = map { $_,1 } qw(DONE REMOTE_DOUBLE_REV DECLINE_CMD
   			   SERVER_VERSION SERVER_SUBVERSION SERVER_BUILT);
   
   my $tests = (1 + @export) - keys %skip; 
  
  
  

Mime
View raw message