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 tie_table.pl
Date Fri, 30 Oct 1998 02:40:04 GMT
dougm       98/10/29 18:40:04

  Modified:    .        Makefile.PL
               Table    Table.pm
               src/modules/perl Table.xs
               t/net/perl tie_table.pl
  Log:
  a bit of Apache::Table optimization
  
  Revision  Changes    Path
  1.106     +5 -7      modperl/Makefile.PL
  
  Index: Makefile.PL
  ===================================================================
  RCS file: /export/home/cvs/modperl/Makefile.PL,v
  retrieving revision 1.105
  retrieving revision 1.106
  diff -u -r1.105 -r1.106
  --- Makefile.PL	1998/10/29 20:53:24	1.105
  +++ Makefile.PL	1998/10/30 02:40:01	1.106
  @@ -151,7 +151,7 @@
   $PERL_EXTRA_CFLAGS = "";
   $SSLCacheServerPort = 8539;
   $SSL_BASE = ""; 
  -$Port = 8529;
  +$Port = $Is_dougm ? 8530 : 8529;
   #so Doug can 'make test' different-builds@sametime/samebox
   if(!$Is_Win32 and $ENV{RANDOM_PORT} and $$ > 8000 and $$ < 30000) {
       $PORT ||= $$;
  @@ -444,7 +444,8 @@
   	    $USE_APACI = $USE_DSO = 0;
   	    
   	}
  -	for (qw(PERL_LOG_API PERL_URI_API PERL_UTIL_API PERL_FILE_API)) {
  +	for my $api (qw(LOG URI UTIL FILE TABLE)) {
  +	    local $_ = join "_", "PERL", $api, "API";
   	    if(($mmn < MMN_130) and $$_) { #1.3.0
   		$$_ = 0;
   		$cant_hook{$_} = "(need 1.3.0 or higher)";
  @@ -591,10 +592,7 @@
       push @xs_modules, "Apache::ModuleConfig";
       $callback_hooks{PERL_DIRECTIVE_HANDLERS} = 1;
   }
  -if($PERL_TABLE_API) {
  -    push @xs_modules, "Apache::Table";
  -    $callback_hooks{PERL_TABLE_API} = 1;
  -}
  +
   if($PERL_RUN_XS or $experimental{PERL_RUN_XS} > 1) {
       my $mmn    = $USE_APXS ? MMN_130 : magic_number($APACHE_SRC);
       if($mmn >= MMN_130) {
  @@ -606,7 +604,7 @@
   	print "Sorry, need 1.3.0+ for Apache::PerlRunXS\n";
       }
   }
  -for (qw(Log URI Util Connection Server File)) {
  +for (qw(Log URI Util Connection Server File Table)) {
       my $s = "PERL_".uc($_)."_API";
       if($$s) {
   	push @xs_modules, "Apache::$_";
  
  
  
  1.2       +0 -1      modperl/Table/Table.pm
  
  Index: Table.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/Table/Table.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Table.pm	1998/10/29 20:53:29	1.1
  +++ Table.pm	1998/10/30 02:40:02	1.2
  @@ -9,7 +9,6 @@
   if($ENV{MOD_PERL}) {
       __PACKAGE__->bootstrap($VERSION);
   }
  -*DESTROY = \&destroy; #avoid weird xsubpp bug
   
   1;
   
  
  
  
  1.2       +42 -24    modperl/src/modules/perl/Table.xs
  
  Index: Table.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Table.xs,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Table.xs	1998/10/29 20:53:31	1.1
  +++ Table.xs	1998/10/30 02:40:03	1.2
  @@ -1,23 +1,22 @@
   #include "mod_perl.h"
   
   typedef struct {
  -    SV *sv;
       SV *cv;
  -    HV *hv;
  +    table *only;
   } TableDo;
   
  +#define table_pool(t) ((array_header *)(t))->pool
  +
   static int Apache_table_do(TableDo *td, const char *key, const char *val)
   {
       int count=0, rv=1;
       dSP;
   
  -    if(td->hv && !hv_exists(td->hv, (char*)key, strlen(key))) 
  +    if(td->only && !table_get(td->only, key))
          return 1;
   
       ENTER;SAVETMPS;
       PUSHMARK(sp);
  -    if(td->sv && (td->sv != &sv_undef))
  -	XPUSHs(td->sv);
       XPUSHs(sv_2mortal(newSVpv((char *)key,0)));
       XPUSHs(sv_2mortal(newSVpv((char *)val,0)));
       PUTBACK;
  @@ -52,6 +51,16 @@
   
   }
   
  +static Apache__Table ApacheTable_new(table *table)
  +{
  +    Apache__Table RETVAL = (Apache__Table)safemalloc(sizeof(TiedTable));
  +    RETVAL->table = table;
  +    RETVAL->ix = 0;
  +    RETVAL->elts = NULL;
  +    RETVAL->arr = NULL;
  +    return RETVAL;
  +}
  +
   MODULE = Apache::Table		PACKAGE = Apache::Table
   
   PROTOTYPES: DISABLE
  @@ -66,21 +75,35 @@
   
       CODE:
       if(!class) XSRETURN_UNDEF;
  -    RETVAL = (Apache__Table)safemalloc(sizeof(TiedTable));
  -    RETVAL->table = table;
  -    RETVAL->ix = 0;
  -    RETVAL->elts = NULL;
  -    RETVAL->arr = NULL;
  +    RETVAL = ApacheTable_new(table);
   
       OUTPUT:
       RETVAL
   
  +Apache::Table
  +new(class, r, nalloc=10)
  +    SV *class
  +    Apache r
  +    int nalloc
  +
  +    CODE:
  +    if(!class) XSRETURN_UNDEF;
  +    RETVAL = ApacheTable_new(make_table(r->pool, nalloc));
  +
  +    OUTPUT:
  +    RETVAL
  +
   void
  -destroy(self)
  -    Apache::Table self
  +DESTROY(self)
  +    SV *self
  +
  +    PREINIT:
  +    Apache__Table tab;
   
       CODE:
  -    safefree(self);
  +    tab = (Apache__Table)hvrv2table(self);
  +    if(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV) 
  +        safefree(tab);
   
   void
   FETCH(self, key)
  @@ -215,31 +238,26 @@
       table_modify(self, key, sv, table_merge);
   
   void
  -do(self, cv, sv=Nullsv, ...)
  +do(self, cv, ...)
       Apache::Table self
       SV *cv
  -    SV *sv
   
       PREINIT:
       TableDo td;
  -    HV *hv = Nullhv;
  +    td.only = (table *)NULL;
   
       CODE:
  -    if(items > 3) {
  +    if(items > 2) {
   	int i;
   	STRLEN len;
  -	hv = newHV();
  -	for(i=3; ; i++) {
  +        td.only = make_table(table_pool(self->table), items-2);
  +	for(i=2; ; i++) {
   	    char *key = SvPV(ST(i),len);
  -	    hv_store(hv, key, len, newSViv(1), FALSE);
  +	    table_set(td.only, key, "1");
   	    if(i == (items - 1)) break; 
   	}
       }
  -    td.sv = sv;
       td.cv = cv;
  -    td.hv = hv;
   
       table_do((int (*) (void *, const char *, const char *)) Apache_table_do,
   	    (void *) &td, self->table, NULL);
  -
  -    if(hv) SvREFCNT_dec(hv);
  
  
  
  1.8       +9 -9      modperl/t/net/perl/tie_table.pl
  
  Index: tie_table.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/tie_table.pl,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -r1.7 -r1.8
  --- tie_table.pl	1998/10/29 20:53:33	1.7
  +++ tie_table.pl	1998/10/30 02:40:03	1.8
  @@ -62,26 +62,26 @@
   test ++$i, $Seen{two};
   
   %Seen = ();
  -$r->notes->do(\&print_header, undef, qw(three));
  +$r->notes->do(\&print_header, qw(three));
   test ++$i, not exists $Seen{two};
   
  -sub str_header {
  -    my($av, $k, $v) = @_;
  -    push @$av, "$k: $v";
  -    1;
  -}
  -
   sub my_as_string {
       my $r = shift;
       my @retval = ();
       push @retval, $r->the_request;
  +
  +    my $str_header = sub {
  +	my($k, $v) = @_;
  +	push @retval, "$k: $v";
  +	1;
  +    };
   
  -    $r->headers_in->do(\&str_header, \@retval);
  +    $r->headers_in->do($str_header);
       push @retval, "";
   
       push @retval, join(" ", $r->protocol, $r->status_line);
       for my $meth (qw(headers_out err_headers_out)) {
  -	$r->$meth()->do(\&str_header, \@retval);
  +	$r->$meth()->do($str_header);
       }
       push @retval, "", "";
       join "\n", grep { defined $_ } @retval;
  
  
  

Mime
View raw message