You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/09/03 03:49:50 UTC

cvs commit: modperl/t/net/perl api.pl

dougm       98/09/02 18:49:48

  Modified:    .        Changes ToDo
               Apache   Apache.pm
               src/modules/perl Apache.xs
               t/net/perl api.pl
  Log:
  deprecate $r->cgi_{env,var}, $r->subprocess_env can do all that and
  them some
  (we get a bit of cleanup and another chip off the old bloat too)
  
  Revision  Changes    Path
  1.132     +3 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.131
  retrieving revision 1.132
  diff -u -r1.131 -r1.132
  --- Changes	1998/09/02 23:52:37	1.131
  +++ Changes	1998/09/03 01:49:45	1.132
  @@ -8,6 +8,9 @@
   
   =item 1.15_01-dev
   
  +deprecate $r->cgi_{env,var}, $r->subprocess_env can do all that and
  +them some
  +
   when rwrite() returns -1, break out of the loop, no longer checking
   r->connection->aborted 
   
  
  
  
  1.76      +0 -2      modperl/ToDo
  
  Index: ToDo
  ===================================================================
  RCS file: /export/home/cvs/modperl/ToDo,v
  retrieving revision 1.75
  retrieving revision 1.76
  diff -u -r1.75 -r1.76
  --- ToDo	1998/09/02 23:52:00	1.75
  +++ ToDo	1998/09/03 01:49:46	1.76
  @@ -239,8 +239,6 @@
               these things at some point
   ---------------------------------------------------------------------------
   
  -merge cgi_env/subprocess_env
  -
   change cgi_header_out and send_cgi_header to use new
   ap_scan_script_header_err_core function 
   
  
  
  
  1.17      +0 -34     modperl/Apache/Apache.pm
  
  Index: Apache.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/Apache/Apache.pm,v
  retrieving revision 1.16
  retrieving revision 1.17
  diff -u -r1.16 -r1.17
  --- Apache.pm	1998/09/01 20:03:36	1.16
  +++ Apache.pm	1998/09/03 01:49:47	1.17
  @@ -63,12 +63,6 @@
   	       $val ? $r->query_string($val) : $r->query_string);
   }
   
  -sub cgi_var {
  -    my($r, $key) = @_;
  -    my $val = $r->cgi_env($key);
  -    return $val;
  -}
  -
   *READ = \&read unless defined &READ;
   
   sub read {
  @@ -925,34 +919,6 @@
   type of interface.
   
   =over 4
  -
  -=item $r->cgi_env
  -
  -Return a %hash that can be used to set up a standard CGI environment.
  -Typical usage would be:
  -
  -   %ENV = $r->cgi_env
  -
  -B<NOTE:> The $ENV{GATEWAY_INTERFACE} is set to C<'CGI-Perl/1.1'> so
  -you can say:
  -
  -   if($ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/) {
  -       # do mod_perl stuff
  -   }
  -   else {
  -       # do normal CGI stuff
  -   }
  -
  -When given a key => value pair, this will set an environment variable.
  -
  -   $r->cgi_env(REMOTE_GROUP => "camels");
  -
  -=item $r->cgi_var($key);
  -
  -Calls $r->cgi_env($key) in a scalar context to prevent the mistake
  -of calling in a list context.
  -
  -   my $doc_root = $r->cgi_env('DOCUMENT_ROOT');
   
   =item $r->send_cgi_header()
   
  
  
  
  1.56      +17 -33    modperl/src/modules/perl/Apache.xs
  
  Index: Apache.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
  retrieving revision 1.55
  retrieving revision 1.56
  diff -u -r1.55 -r1.56
  --- Apache.xs	1998/09/02 23:52:38	1.55
  +++ Apache.xs	1998/09/03 01:49:47	1.56
  @@ -1121,49 +1121,33 @@
       if(sv) SvREFCNT_dec(sv);
   
   #methods for creating a CGI environment
  -void
  -cgi_env(r, ...)
  -    Apache	r
   
  -    PREINIT:
  -    char *key = NULL;
  -    I32 gimme = GIMME_V;
  -
  -    PPCODE:
  -    if(items > 1) {
  -	key = SvPV(ST(1),na);
  -	if(items > 2) 
  -	    table_set(r->subprocess_env, key, SvPV(ST(2),na));
  -    }
  -
  -    if((gimme == G_ARRAY) || (gimme == G_VOID)) {
  -        int i;
  -        array_header *arr  = perl_cgi_env_init(r);
  -        table_entry *elts = (table_entry *)arr->elts;
  -        if(gimme == G_ARRAY) {
  -	    for (i = 0; i < arr->nelts; ++i) {
  -	        if (!elts[i].key) continue;
  -	        PUSHelt(elts[i].key, elts[i].val, 0);
  -	    }
  -        }
  -    }
  -    else if(key) {
  -	char *value = (char *)table_get(r->subprocess_env, key);
  -	XPUSHs(value ? sv_2mortal((SV*)newSVpv(value, 0)) : &sv_undef);
  -    }
  -    else
  -        croak("Apache->cgi_env: need another argument in scalar context"); 
  -   
  -
   SV *
   subprocess_env(r, key=NULL, ...)
       Apache    r
       char *key
   
  +    ALIAS:
  +    Apache::cgi_env = 1
  +    Apache::cgi_var = 2
  +
       PREINIT:
       I32 gimme = GIMME_V;
    
       CODE:
  +    if(((ix = XSANY.any_i32) == 1) && (gimme == G_ARRAY)) {
  +	/* backwards compat */
  +	int i;
  +	array_header *arr  = perl_cgi_env_init(r);
  +	table_entry *elts = (table_entry *)arr->elts;
  +	SP -= items;
  +	for (i = 0; i < arr->nelts; ++i) {
  +	    if (!elts[i].key) continue;
  +	    PUSHelt(elts[i].key, elts[i].val, 0);
  +	}
  +	PUTBACK;
  +	return;
  +    }
       if((items == 1) && (gimme == G_VOID)) {
           (void)perl_cgi_env_init(r);
           XSRETURN_UNDEF;
  
  
  
  1.29      +16 -3     modperl/t/net/perl/api.pl
  
  Index: api.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
  retrieving revision 1.28
  retrieving revision 1.29
  diff -u -r1.28 -r1.29
  --- api.pl	1998/09/01 20:03:38	1.28
  +++ api.pl	1998/09/03 01:49:48	1.29
  @@ -13,11 +13,10 @@
       $r = Apache->request;
   }
   
  -%ENV = $r->cgi_env;
  -$r->subprocess_env; #test void context
  +
   my $is_xs = ($r->uri =~ /_xs/);
   
  -my $tests = 49;
  +my $tests = 50;
   my $is_win32 = WIN32;
   ++$tests unless $is_win32;
   my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
  @@ -29,7 +28,20 @@
   $r->content_type("text/plain");
   $r->content_languages([qw(en)]);
   $r->send_http_header;
  +
   $r->print("1..$tests\n");
  +
  +#backward compat
  +%ENV = $r->cgi_env;
  +my $envk = keys %ENV;
  +#print "cgi_env ($envk):\n";
  +#print map { "$_ = $ENV{$_}\n" } keys %ENV;
  +
  +$r->subprocess_env; #test void context
  +$envk = keys %ENV;
  +#print "subprocess_env ($envk):\n";
  +#print map { "$_ = $ENV{$_}\n" } keys %ENV;
  +
   test ++$i, $r->as_string;
   print $r->as_string;
   print "r == $r\n";
  @@ -57,6 +69,7 @@
   
   test ++$i, $r->last;
   test ++$i, $ENV{GATEWAY_INTERFACE};
  +test ++$i, scalar $r->cgi_var('GATEWAY_INTERFACE');
   test ++$i, defined($r->seqno);
   test ++$i, $r->protocol;
   #hostname