Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 23 Jan 2004 15:26:56 -0000
Message-ID: <20040123152656.82451.qmail@minotaur.apache.org>
From: geoff@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm

geoff       2004/01/23 07:26:56

  Modified:    xs/APR/Brigade APR__Brigade.h
               xs/maps  apr_functions.map
               xs/tables/current/ModPerl FunctionTable.pm
  Added:       t/response/TestAPR flatten.pm
  Log:
  expose APR::Brigade::length() and APR::Brigade::flatten()
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/response/TestAPR/flatten.pm
  
  Index: flatten.pm
  ===================================================================
  package TestAPR::flatten;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::RequestRec ();
  use APR::Bucket ();
  use APR::Brigade ();
  
  use Apache::Const -compile => 'OK';
  
  sub handler {
  
      my $r = shift;
  
      plan $r, tests => 9;
  
      # first, create a brigade
      my $bb = APR::Brigade->new($r->pool, 
                                 $r->connection->bucket_alloc);
  
      # now, let's put several buckets in it
      for (1 .. 10) {
          my $data = 'x' x 20000;
          my $bucket = APR::Bucket->new($data);
          $bb->insert_tail($bucket);
      }
  
      # ok, that's 10 buckets of 20,000 = 200,000 characters
      ok t_cmp(200000,
               $bb->length,
               'APR::Brigade::length()');
  
      # slurp up the entire brigade
      # this is somewhat wasteful, since we're simulating a user
      # 'guessing' at how much data there is to slurp
      {
          my $rc = $bb->flatten(my $data, my $length = 300000);
  
          ok t_cmp(APR::SUCCESS,
                   $rc,
                   'APR::Brigade::flatten() return value');
  
          ok t_cmp(200000,
                   $length,
                   'APR::Brigade::flatten() length population');
  
          ok t_cmp(200000,
                   length($data),
                   'APR::Brigade::flatten() returned all the data');
  
          # don't use t_cmp() here, else we get 200,000 characters
          # to look at in verbose mode
          t_debug("APR::Brigade::flatten() data all 'x' characters");
          ok ($data !~ m/[^x]/);
      }
  
      # test that other length variants - such as constants and
      # subroutine returns - don't segfault
      {
          my $rc = $bb->flatten(my $data, 300000);
  
          ok t_cmp(APR::SUCCESS,
               $rc,
               'APR::Brigade::flatten() return value');
      }
  
      # this is probably the best example of using flatten() to
      # get the entire brigade - using $bb->length to determine 
      # the full size of the brigade.
      # probably still inefficient, though...
      {
          my $rc = $bb->flatten(my $data, $bb->length);
  
          ok t_cmp(APR::SUCCESS,
               $rc,
               'APR::Brigade::flatten() return value');
      }
  
      # this is the most proper use of flatten() - retrieving
      # only a chunk of a brigade.  most examples in httpd core
      # use flatten() to grab the first 30 bytes or so
      {
          my $rc = $bb->flatten(my $data, 100000);
  
          ok t_cmp(APR::SUCCESS,
               $rc,
               'APR::Brigade::flatten() return value');
  
          ok t_cmp(100000,
                   length($data),
                   'APR::Brigade::flatten() returned all the data');
      }
  
      # pflatten() examples to come...
  
      Apache::OK;
  }
  
  1;
  
  
  
  1.5       +36 -0     modperl-2.0/xs/APR/Brigade/APR__Brigade.h
  
  Index: APR__Brigade.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/APR/Brigade/APR__Brigade.h,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- APR__Brigade.h	29 Mar 2002 16:16:43 -0000	1.4
  +++ APR__Brigade.h	23 Jan 2004 15:26:55 -0000	1.5
  @@ -67,3 +67,39 @@
       return APR_BRIGADE_EMPTY(brigade);
   }
   
  +static MP_INLINE
  +SV *mpxs_APR__Brigade_length(pTHX_ apr_bucket_brigade *bb,
  +                             int read_all)
  +{
  +    apr_off_t length;
  +
  +    apr_status_t rv = apr_brigade_length(bb, read_all, &length);
  +
  +    /* XXX - we're deviating from the API here a bit in order to
  +     * make it more perlish - returning the length instead of
  +     * the return code.  maybe that's not such a good idea, though...
  +     */
  +    if (rv == APR_SUCCESS) {
  +        return newSViv((int)length);
  +    }
  +
  +    return &PL_sv_undef;
  +}
  +
  +static MP_INLINE
  +apr_status_t mpxs_apr_brigade_flatten(pTHX_ apr_bucket_brigade *bb,
  +                                      SV *sv_buf, SV *sv_len)
  +{
  +    apr_status_t status;
  +    apr_size_t len = mp_xs_sv2_apr_size_t(sv_len);
  +
  +    mpxs_sv_grow(sv_buf, len);
  +    status = apr_brigade_flatten(bb, SvPVX(sv_buf), &len);
  +    mpxs_sv_cur_set(sv_buf, len);
  +
  +    if (!SvREADONLY(sv_len)) {
  +        sv_setiv(sv_len, len);
  +    }
  +
  +    return status;
  +}
  
  
  
  1.66      +3 -2      modperl-2.0/xs/maps/apr_functions.map
  
  Index: apr_functions.map
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
  retrieving revision 1.65
  retrieving revision 1.66
  diff -u -r1.65 -r1.66
  --- apr_functions.map	18 Dec 2003 18:53:50 -0000	1.65
  +++ apr_functions.map	23 Jan 2004 15:26:55 -0000	1.66
  @@ -81,12 +81,12 @@
   -apr_brigade_to_iovec
   -apr_brigade_vprintf
   -apr_brigade_vputstrs
  -!apr_brigade_length
  +~apr_brigade_length
   !apr_brigade_write
   !apr_brigade_puts
   -apr_brigade_putc
   !apr_brigade_cleanup
  -?apr_brigade_flatten
  + apr_brigade_flatten | mpxs_ | bb, SV *:sv_buf, SV *:sv_len
   ?apr_brigade_pflatten
   ?apr_brigade_split_line
    mpxs_APR__Brigade_first        #APR_BRIGADE_FIRST
  @@ -97,6 +97,7 @@
    mpxs_APR__Brigade_insert_head  #APR_BRIGADE_INSERT_HEAD
    mpxs_APR__Brigade_concat       #APR_BRIGADE_CONCAT
    mpxs_APR__Brigade_empty        #APR_BRIGADE_EMPTY
  + mpxs_APR__Brigade_length | | bb, read_all=1
   
   MODULE=APR::Bucket
    mpxs_APR__Bucket_is_flush       #APR_BUCKET_IS_FLUSH
  
  
  
  1.139     +40 -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.138
  retrieving revision 1.139
  diff -u -r1.138 -r1.139
  --- FunctionTable.pm	22 Jan 2004 23:25:54 -0000	1.138
  +++ FunctionTable.pm	23 Jan 2004 15:26:56 -0000	1.139
  @@ -6444,6 +6444,46 @@
       ]
     },
     {
  +    'return_type' => 'SV *',
  +    'name' => 'mpxs_APR__Brigade_length',
  +    'args' => [
  +      {
  +        'type' => 'PerlInterpreter *',
  +        'name' => 'my_perl'
  +      },
  +      {
  +        'type' => 'apr_bucket_brigade *',
  +        'name' => 'bb'
  +      },
  +      {
  +        'type' => 'int',
  +        'name' => 'read_all'
  +      },
  +    ]
  +  },
  +  {
  +    'return_type' => 'apr_status_t',
  +    'name' => 'mpxs_apr_brigade_flatten',
  +    'args' => [
  +      {
  +        'type' => 'PerlInterpreter *',
  +        'name' => 'my_perl'
  +      },
  +      {
  +        'type' => 'apr_bucket_brigade *',
  +        'name' => 'bb'
  +      },
  +      {
  +        'type' => 'SV *',
  +        'name' => 'sv_buf'
  +      },
  +      {
  +        'type' => 'SV *',
  +        'name' => 'sv_len'
  +      },
  +    ]
  +  },
  +  {
       'return_type' => 'apr_ipsubnet_t *',
       'name' => 'mpxs_apr_ipsubnet_create',
       'args' => [