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 tie_table.pl
Date Tue, 01 Sep 1998 20:03:39 GMT
dougm       98/09/01 13:03:39

  Modified:    .        Changes ToDo
               Apache   Apache.pm
               src/modules/perl Apache.xs
               t/net/perl api.pl tie_table.pl
  Log:
  r->as_string now uses table_do() and moved to xs
  
  Revision  Changes    Path
  1.128     +2 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.127
  retrieving revision 1.128
  diff -u -r1.127 -r1.128
  --- Changes	1998/09/01 17:42:05	1.127
  +++ Changes	1998/09/01 20:03:33	1.128
  @@ -8,6 +8,8 @@
   
   =item 1.15_01-dev
   
  +r->as_string now uses table_do() and moved to xs
  +
   use 1.3.2-dev+'s ap_custom_response() when possible
   
   remove Apache::DESTROY method (was only for avoiding old AutoLoader bug)
  
  
  
  1.74      +0 -2      modperl/ToDo
  
  Index: ToDo
  ===================================================================
  RCS file: /export/home/cvs/modperl/ToDo,v
  retrieving revision 1.73
  retrieving revision 1.74
  diff -u -r1.73 -r1.74
  --- ToDo	1998/09/01 17:42:05	1.73
  +++ ToDo	1998/09/01 20:03:33	1.74
  @@ -7,8 +7,6 @@
   
   - make DYNAMIC=1 work again
   
  -- change as_string to use table->do
  -
   - sfio/solaris problem
   Lupe Christoph <lupe@alanya.m.isar.de>, Don Hayward <don@mote.org>
   
  
  
  
  1.16      +0 -23     modperl/Apache/Apache.pm
  
  Index: Apache.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/Apache/Apache.pm,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -r1.15 -r1.16
  --- Apache.pm	1998/09/01 17:12:53	1.15
  +++ Apache.pm	1998/09/01 20:03:36	1.16
  @@ -197,29 +197,6 @@
       }
   }
   
  -sub as_string {
  -    my($r) = @_;
  -    my($k,$v,@retval);
  -    my(%headers_in) = $r->headers_in;
  -
  -    push @retval, $r->the_request;
  -    while(($k,$v) = each %headers_in) {
  -	push @retval, "$k: $v";
  -    }
  -
  -    push @retval, "";
  -
  -    push @retval, $r->status_line;
  -    for (qw(err_headers_out headers_out)) {
  -	my(%headers_out) = $r->$_();
  -
  -	while(($k,$v) = each %headers_out) {
  -	    push @retval, "$k: $v";
  -	}
  -    }    
  -    join "\n", grep { defined $_ } @retval, "";
  -}
  -
   sub TIEHANDLE {
       my($class, $r) = @_;
       $r ||= Apache->request;
  
  
  
  1.54      +25 -0     modperl/src/modules/perl/Apache.xs
  
  Index: Apache.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
  retrieving revision 1.53
  retrieving revision 1.54
  diff -u -r1.53 -r1.54
  --- Apache.xs	1998/09/01 17:54:29	1.53
  +++ Apache.xs	1998/09/01 20:03:38	1.54
  @@ -338,6 +338,13 @@
       return NULL;
   }
   
  +static int sv_str_header(void *arg, const char *k, const char *v)
  +{
  +    SV *sv = (SV*)arg;
  +    sv_catpvf(sv, "%s: %s\n", k, v);
  +    return 1;
  +}
  +
   #if MODULE_MAGIC_NUMBER >= 19980806
   /*
    * ap_scan_script_header_err_core(r, buffer, getsfunc_SV, sv)
  @@ -552,6 +559,24 @@
       CODE:
       items = items;
       /*NOOP*/
  +
  +SV *
  +as_string(r)
  +    Apache r
  +
  +    CODE:
  +    RETVAL = newSVpv(r->the_request,0);
  +    sv_catpvn(RETVAL, "\n", 1);
  +
  +    table_do(sv_str_header, (void*)RETVAL, r->headers_in, NULL);
  +    sv_catpvf(RETVAL, "\n%s %s\n", r->protocol, r->status_line);
  +
  +    table_do(sv_str_header, (void*)RETVAL, r->headers_out, NULL);
  +    table_do(sv_str_header, (void*)RETVAL, r->err_headers_out, NULL);
  +    sv_catpvn(RETVAL, "\n", 1);
  +
  +    OUTPUT:
  +    RETVAL
   
   #httpd.h
        
  
  
  
  1.28      +3 -1      modperl/t/net/perl/api.pl
  
  Index: api.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
  retrieving revision 1.27
  retrieving revision 1.28
  diff -u -r1.27 -r1.28
  --- api.pl	1998/08/28 18:35:07	1.27
  +++ api.pl	1998/09/01 20:03:38	1.28
  @@ -17,7 +17,7 @@
   $r->subprocess_env; #test void context
   my $is_xs = ($r->uri =~ /_xs/);
   
  -my $tests = 48;
  +my $tests = 49;
   my $is_win32 = WIN32;
   ++$tests unless $is_win32;
   my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
  @@ -30,6 +30,8 @@
   $r->content_languages([qw(en)]);
   $r->send_http_header;
   $r->print("1..$tests\n");
  +test ++$i, $r->as_string;
  +print $r->as_string;
   print "r == $r\n";
   test ++$i, $r->filename eq $0;
   test ++$i, -d $Apache::Server::CWD;
  
  
  
  1.6       +39 -0     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.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- tie_table.pl	1998/08/11 16:52:39	1.5
  +++ tie_table.pl	1998/09/01 20:03:38	1.6
  @@ -65,6 +65,45 @@
   $r->notes->do(\&print_header, undef, 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;
  +
  +    $r->headers_in->do(\&str_header, \@retval);
  +    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);
  +    }
  +    push @retval, "", "";
  +    join "\n", grep { defined $_ } @retval;
  +}
  +
  +use Benchmark;
  +if(my_as_string($r) eq $r->as_string) {
  +    print "as_string match\n";
  +}
  +else {
  +    print "as_string MIS-match\n";
  +    print "-" x 20, $/; 
  +    print my_as_string($r);
  +    print "-" x 20, $/; 
  +    print $r->as_string;
  +    print "-" x 20, $/; 
  +}
  +#timethese(1_000, { 
  +#    Perl => sub {my $my_as_string = my_as_string($r)},
  +#    C    => sub {my $as_string = $r->as_string;},
  +#});
  +
   for my $meth (qw{
       headers_in headers_out err_headers_out notes dir_config subprocess_env
       })
  
  
  

Mime
View raw message