perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: modperl-2.0/xs/maps apache_functions.map
Date Sat, 28 Apr 2001 22:35:23 GMT
dougm       01/04/28 15:35:23

  Modified:    lib/ModPerl TypeMap.pm WrapXS.pm
               src/modules/perl modperl_util.c modperl_util.h
               xs       modperl_xs_util.h
               xs/maps  apache_functions.map
  Added:       t/response/TestAPI uri.pm
               xs/Apache/URI Apache__URI.h
  Log:
  add Apache::URI interface and tests
  
  Revision  Changes    Path
  1.6       +6 -4      modperl-2.0/lib/ModPerl/TypeMap.pm
  
  Index: TypeMap.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TypeMap.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- TypeMap.pm	2001/03/16 00:26:29	1.5
  +++ TypeMap.pm	2001/04/28 22:35:18	1.6
  @@ -332,10 +332,12 @@
   }
   
   #XXX: generate this
  -my %class_pools = (
  -    'Apache::RequestRec' => '.pool',
  -    'Apache::Connection' => '.pool',
  -);
  +my %class_pools = map {
  +    (my $f = "mpxs_${_}_pool") =~ s/:/_/g;
  +    $_, $f;
  +} qw{
  +   Apache::RequestRec Apache::Connection Apache::URI
  +};
   
   sub class_pool : lvalue {
       my($self, $class) = @_;
  
  
  
  1.9       +1 -1      modperl-2.0/lib/ModPerl/WrapXS.pm
  
  Index: WrapXS.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- WrapXS.pm	2001/04/20 18:03:45	1.8
  +++ WrapXS.pm	2001/04/28 22:35:19	1.9
  @@ -150,7 +150,7 @@
   
       if ($e->{class} eq 'PV') {
           if (my $pool = $e->{pool}) {
  -            $pool =~ s/^\./obj->/;
  +            $pool .= '(obj)';
               $val = "((ST(1) == &PL_sv_undef) ? NULL :
                       (SvPOK(ST(1)) ?
                       apr_pstrndup($pool, SvPVX(ST(1)), SvCUR(ST(1))) :
  
  
  
  1.10      +40 -0     modperl-2.0/src/modules/perl/modperl_util.c
  
  Index: modperl_util.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- modperl_util.c	2001/04/25 05:27:17	1.9
  +++ modperl_util.c	2001/04/28 22:35:20	1.10
  @@ -66,6 +66,46 @@
       return sv;
   }
   
  +apr_pool_t *modperl_sv2pool(pTHX_ SV *obj)
  +{
  +    char *classname;
  +
  +    if (!(SvROK(obj) && (SvTYPE(SvRV(obj)) == SVt_PVMG))) {
  +        return NULL;
  +    }
  +
  +    classname = SvCLASS(obj);
  +
  +    if (*classname != 'A') {
  +        return NULL;
  +    }
  +
  +    if (strnEQ(classname, "APR::", 5)) {
  +        classname += 5;
  +        switch (*classname) {
  +          case 'P':
  +            if (strEQ(classname, "Pool")) {
  +                return (apr_pool_t *)SvObjIV(obj);
  +            }
  +          default:
  +            return NULL;
  +        };
  +    }
  +    else if (strnEQ(classname, "Apache::", 8)) {
  +        classname += 8;
  +        switch (*classname) {
  +          case 'R':
  +            if (strEQ(classname, "RequestRec")) {
  +                return ((request_rec *)SvObjIV(obj))->pool;
  +            }
  +          default:
  +            return NULL;
  +        };
  +    }
  +
  +    return NULL;
  +}
  +
   char *modperl_apr_strerror(apr_status_t rv)
   {
       dTHX;
  
  
  
  1.11      +8 -0      modperl-2.0/src/modules/perl/modperl_util.h
  
  Index: modperl_util.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_util.h	2001/04/25 05:27:17	1.10
  +++ modperl_util.h	2001/04/28 22:35:20	1.11
  @@ -14,11 +14,19 @@
   #   define strncaseEQ(s1,s2,l) (!strncasecmp(s1,s2,l))
   #endif
   
  +#ifndef SvCLASS
  +#define SvCLASS(o) HvNAME(SvSTASH(SvRV(o)))
  +#endif
  +
  +#define SvObjIV(o) SvIV((SV*)SvRV(o))
  +
   MP_INLINE request_rec *modperl_sv2request_rec(pTHX_ SV *sv);
   
   MP_INLINE SV *modperl_newSVsv_obj(pTHX_ SV *stashsv, SV *obj);
   
   MP_INLINE SV *modperl_ptr2obj(pTHX_ char *classname, void *ptr);
  +
  +apr_pool_t *modperl_sv2pool(pTHX_ SV *obj);
   
   #define modperl_bless_request_rec(r) \
   modperl_ptr2obj("Apache", r)
  
  
  
  1.1                  modperl-2.0/t/response/TestAPI/uri.pm
  
  Index: uri.pm
  ===================================================================
  package TestAPI::uri;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::URI ();
  use Apache::RequestUtil ();
  use Apache::Test;
  
  my $location = '/' . __PACKAGE__;
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 12;
  
      $r->args('query');
  
      my $uri = $r->parsed_uri;
  
      ok $uri->isa('Apache::URI');
  
      ok $uri->path =~ m:^$location:;
  
      my $up = $uri->unparse;
      ok $up =~ m:^$location:;
  
      my $parsed = Apache::URI->parse($r);
  
      ok $parsed->isa('Apache::URI');
  
      $up = $parsed->unparse;
  
      ok $up =~ m:$location:;
  
      ok $parsed->query eq $r->args;
  
      my $path = '/foo/bar';
  
      $parsed->path($path);
  
      ok $parsed->path eq $path;
  
      my $newr = Apache::RequestRec->new($r->connection);
      my $url_string = "$path?query";
  
      $newr->parse_uri($url_string);
  
      ok $newr->uri eq $path;
  
      ok $newr->args eq 'query';
  
      ok $newr->parsed_uri->path eq $path;
  
      ok $newr->parsed_uri->query eq 'query';
  
      my @c = qw(one two three);
      $url_string = join '%20', @c;
  
      Apache::unescape_url($url_string);
  
      ok $url_string eq "@c";
  
      Apache::OK;
  }
  
  1;
  
  
  
  1.7       +4 -0      modperl-2.0/xs/modperl_xs_util.h
  
  Index: modperl_xs_util.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/modperl_xs_util.h,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- modperl_xs_util.h	2001/04/19 21:26:40	1.6
  +++ modperl_xs_util.h	2001/04/28 22:35:21	1.7
  @@ -1,6 +1,10 @@
   #ifndef MODPERL_XS_H
   #define MODPERL_XS_H
   
  +#define mpxs_Apache__RequestRec_pool(r) r->pool
  +#define mpxs_Apache__Connection_pool(c) c->pool
  +#define mpxs_Apache__URI_pool(u)        ((modperl_uri_t *)u)->pool
  +
   #ifndef dAX
   #    define dAX    I32 ax = mark - PL_stack_base + 1
   #endif
  
  
  
  1.1                  modperl-2.0/xs/Apache/URI/Apache__URI.h
  
  Index: Apache__URI.h
  ===================================================================
  /* subclass uri_components */
  typedef struct {
      uri_components uri;
      apr_pool_t *pool;
      char *path_info;
  } modperl_uri_t;
  
  static MP_INLINE
  modperl_uri_t *mpxs_uri_new(apr_pool_t *p)
  {
      modperl_uri_t *uri = (modperl_uri_t *)apr_pcalloc(p, sizeof(*uri));
      uri->pool = p;
      return uri;
  }
  
  static MP_INLINE
  uri_components *mpxs_Apache__RequestRec_parsed_uri(request_rec *r)
  {
      modperl_uri_t *uri = mpxs_uri_new(r->pool);
  
      uri->uri = r->parsed_uri;
      uri->path_info = r->path_info;
  
      return (uri_components *)uri;
  }
  
  static MP_INLINE
  char *mpxs_ap_unparse_uri_components(pTHX_
                                       uri_components *uptr,
                                       unsigned flags)
  {
      return ap_unparse_uri_components(((modperl_uri_t *)uptr)->pool,
                                       uptr, flags);
  }
  
  static MP_INLINE
  uri_components *mpxs_ap_parse_uri_components(pTHX_
                                               SV *classname,
                                               SV *obj,
                                               const char *uri_string)
  {
      request_rec *r = NULL;
      apr_pool_t *p = modperl_sv2pool(aTHX_ obj);
      modperl_uri_t *uri = mpxs_uri_new(p);
  
      if (!p) {
          return NULL;
      }
  
      if (!uri_string) {
          r = mp_xs_sv2_r(obj);
          uri_string = ap_construct_url(r->pool, r->uri, r);
      }
  
      (void)ap_parse_uri_components(p, uri_string, &uri->uri);
  
      if (r) {
          uri->uri.query = r->args;
      }
  
      return (uri_components *)uri;
  }
  
  static MP_INLINE int mpxs_ap_unescape_url(pTHX_ SV *url)
  {
      int status;
      STRLEN n_a;
  
      (void)SvPV_force(url, n_a);
  
      if ((status = ap_unescape_url(SvPVX(url))) == OK) {
          SvCUR_set(url, strlen(SvPVX(url)));
      }
  
      return status;
  }
  
  
  
  1.15      +8 -4      modperl-2.0/xs/maps/apache_functions.map
  
  Index: apache_functions.map
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- apache_functions.map	2001/04/28 19:29:44	1.14
  +++ apache_functions.map	2001/04/28 22:35:23	1.15
  @@ -243,11 +243,15 @@
    ap_os_escape_path
   
   MODULE=Apache::URI   PACKAGE=guess
  + ap_unescape_url | mpxs_ | SV *:url
    ap_parse_uri
  - ap_parse_uri_components
  - ap_parse_hostinfo_components
  - ap_unescape_url
  - ap_unparse_uri_components
  +!ap_parse_hostinfo_components
  + uri_components *:ap_parse_uri_components | mpxs_ | \
  +                     SV *:classname, SV *:p, uri=NULL | parse
  + ap_unparse_uri_components | mpxs_ | \
  +                     uptr, flags=UNP_OMITPASSWORD | unparse
  +PACKAGE=Apache::RequestRec
  + mpxs_Apache__RequestRec_parsed_uri
   
   !MODULE=Apache::StringUtil   PACKAGE=guess
    ap_checkmask
  
  
  

Mime
View raw message