httpd-apreq-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From j...@apache.org
Subject cvs commit: httpd-apreq-2/glue/perl/xsbuilder/maps apreq_functions.map
Date Sun, 13 Jul 2003 05:03:49 GMT
joes        2003/07/12 22:03:49

  Modified:    glue/perl/t/apreq cookie.t
               glue/perl/t/response/TestApReq cookie.pm
               glue/perl/xsbuilder apreq_xs_postperl.h
               glue/perl/xsbuilder/Apache/Cookie Cookie_pm
               glue/perl/xsbuilder/maps apreq_functions.map
  Log:
  Perl API fixes: mortalize env, add wrappers for apreq_encode and apreq_decode, and decode
cookie value, moving (unencoded) cookie value accessor to raw_value
  
  Revision  Changes    Path
  1.4       +21 -4     httpd-apreq-2/glue/perl/t/apreq/cookie.t
  
  Index: cookie.t
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/apreq/cookie.t,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- cookie.t	17 Jun 2003 11:33:43 -0000	1.3
  +++ cookie.t	13 Jul 2003 05:03:49 -0000	1.4
  @@ -7,13 +7,21 @@
   use Apache::TestRequest qw(GET_BODY);
   use HTTP::Cookies;
   
  -plan tests => 1;
  +plan tests => 3;
   
   my $location = "/TestApReq__cookie";
   
   {
  -    # basic param() test
  -    my $test  = 'basic';
  +    my $test  = 'netscape';
  +    my $key   = 'apache';
  +    my $value = 'ok';
  +    my $cookie = qq{$key=$value};
  +    ok t_cmp($value,
  +             GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
  +             $test);
  +}
  +{
  +    my $test  = 'rfc';
       my $key   = 'apache';
       my $value = 'ok';
       my $cookie = qq{\$Version="1"; $key="$value"; \$Path="$location"};
  @@ -21,4 +29,13 @@
                GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
                $test);
   }
  -
  +{
  +    my $test  = 'encoded value with space';
  +    my $key   = 'apache';
  +    my $value = 'okie dokie';
  +    my $cookie = "$key=" . join '',
  +        map {/ / ? '+' : sprintf '%%%.2X', ord} split //, $value;
  +    ok t_cmp($value,
  +             GET_BODY("$location?test=$test&key=$key", Cookie => $cookie),
  +             $test);
  +}
  
  
  
  1.4       +2 -6      httpd-apreq-2/glue/perl/t/response/TestApReq/cookie.pm
  
  Index: cookie.pm
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/cookie.pm,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- cookie.pm	10 Jun 2003 14:43:10 -0000	1.3
  +++ cookie.pm	13 Jul 2003 05:03:49 -0000	1.4
  @@ -21,12 +21,8 @@
       my $test = $apr->param('test');
       my $key  = $apr->param('key');
   
  -#    return DECLINED unless defined $test;
  -
  -    if ($test eq 'basic') {
  -        if ($cookies{$key}) {
  -            $r->print($cookies{$key}->value);
  -        }
  +    if ($cookies{$key}) {
  +        $r->print($cookies{$key}->value);
       }
   
   
  
  
  
  1.14      +43 -2     httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h
  
  Index: apreq_xs_postperl.h
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -r1.13 -r1.14
  --- apreq_xs_postperl.h	11 Jul 2003 23:16:58 -0000	1.13
  +++ apreq_xs_postperl.h	13 Jul 2003 05:03:49 -0000	1.14
  @@ -202,12 +202,13 @@
           void *env = apreq_xs_sv2env(sv);                \
                                                           \
           if (env)                                        \
  -            ST(0) = sv_setref_pv(newSV(0), class, env); \
  +            ST(0) = sv_2mortal(sv_setref_pv(newSV(0),   \
  +                                          class, env)); \
           else                                            \
               ST(0) = &PL_sv_undef;                       \
       }                                                   \
       else                                                \
  -        ST(0) = newSVpv(class, 0);                      \
  +        ST(0) = sv_2mortal(newSVpv(class, 0));          \
                                                           \
       XSRETURN(1);                                        \
   }
  @@ -378,6 +379,46 @@
       default:                                                            \
           XSRETURN(0);                                                    \
       }                                                                   \
  +}
  +
  +static XS(apreq_xs_encode)
  +{
  +    dXSARGS;
  +    STRLEN slen;
  +    const char *src;
  +
  +    if (items != 1)
  +        Perl_croak(aTHX_ "Usage: encode($string)");
  +
  +    src = SvPV(ST(0), slen);
  +    ST(0) = sv_newmortal();
  +    SvUPGRADE(ST(0), SVt_PV);
  +    SvGROW(ST(0), 3 * slen + 1);
  +    SvCUR(ST(0)) = apreq_encode(SvPVX(ST(0)), src, slen);
  +    SvPOK_on(ST(0));
  +    XSRETURN(1);
  +}
  +
  +static XS(apreq_xs_decode)
  +{
  +    dXSARGS;
  +    STRLEN slen;
  +    apr_ssize_t len;
  +    const char *src;
  +
  +    if (items != 1)
  +        Perl_croak(aTHX_ "Usage: decode($string)");
  +
  +    src = SvPV(ST(0), slen);
  +    ST(0) = sv_newmortal();
  +    SvUPGRADE(ST(0), SVt_PV);
  +    SvGROW(ST(0), slen + 1);
  +    len = apreq_decode(SvPVX(ST(0)), src, slen);
  +    if (len < 0)
  +        XSRETURN_UNDEF;
  +    SvCUR_set(ST(0),len);
  +    SvPOK_on(ST(0));
  +    XSRETURN(1);
   }
   
   
  
  
  
  1.8       +13 -15    httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Cookie_pm
  
  Index: Cookie_pm
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Cookie_pm,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -r1.7 -r1.8
  --- Cookie_pm	24 Jun 2003 22:27:44 -0000	1.7
  +++ Cookie_pm	13 Jul 2003 05:03:49 -0000	1.8
  @@ -1,5 +1,5 @@
   use strict;
  -use warnings;# FATAL => 'all';
  +use warnings FATAL => 'all';
   use Apache2;
   use APR;
   use APR::Table;
  @@ -12,7 +12,6 @@
   
   
   package Apache::Cookie;
  -#push our(@ISA), __PACKAGE__ -> env;
   use Devel::Peek;
   
   sub jar {
  @@ -26,7 +25,7 @@
       my $value = delete $attrs{value} || delete $attrs{-value};
       return unless defined $name and defined $value;
   
  -    my $cookie = $class->make($env, $class->freeze($name, $value));
  +    my $cookie = $class->make($env, $name, $class->freeze($value));
       $cookie->set_attr(%attrs);
       return $cookie;
   }
  @@ -34,28 +33,27 @@
   sub fetch {
       my $self = shift;
       my $jar = $self->jar(@_);
  -    Dump(scalar $jar->cookie);
  -    Dump($jar->get("apache"));
       return wantarray ? %{scalar $jar->cookie} : $jar->cookie;
   }
   
   sub freeze {
  -    my ($class, $name, $value) = @_;
  -    return ($name, url_encode($value)) if not ref $value;
  -    return ($name, $value->freeze) if $value->can("freeze");
  -    if ($value->isa("ARRAY")) {
  -        return $name, join '&', map url_encode($_), @$value;
  +    my ($class, $value) = @_;
  +    return encode($value) if not ref $value;
  +    return $value->freeze if UNIVERSAL::can($value,"freeze");
  +    if (UNIVERSAL::isa($value,"ARRAY")) {
  +        return join '&', map encode($_), @$value;
       }
  -    elsif ($value->isa("HASH")) {
  -        return $name, join '&', map url_encode($_), %$value;
  +    elsif (UNIVERSAL::isa($value,"HASH")) {
  +        return join '&', map encode($_), %$value;
       }
       else {
           die "Can't freeze '$value'";
       }
   }
   
  -sub thaw {
  +sub value {
       my $self = shift;
  -    return map url_decode($_), split /&/, $self;
  +    return $self->thaw if $self->can("thaw");
  +    my @rv = map decode($_), split /&/, $self->raw_value;
  +    return wantarray ? @rv : $rv[0];
   }
  -
  
  
  
  1.13      +3 -1      httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map
  
  Index: apreq_functions.map
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- apreq_functions.map	30 Jun 2003 20:42:14 -0000	1.12
  +++ apreq_functions.map	13 Jul 2003 05:03:49 -0000	1.13
  @@ -43,8 +43,10 @@
    DEFINE_expires    | apreq_xs_cookie_expires   |
    DEFINE_set_attr   | apreq_xs_cookie_set_attr  |
    DEFINE_env        | apreq_xs_cookie_env  |
  + DEFINE_encode     | apreq_xs_encode |
  + DEFINE_decode     | apreq_xs_decode |
    const char *:DEFINE_name | apreq_cookie_name(c)  | apreq_cookie_t *:c
  - const char *:DEFINE_value| apreq_cookie_value(c) | apreq_cookie_t *:c
  + const char *:DEFINE_raw_value| apreq_cookie_value(c) | apreq_cookie_t *:c
    apr_status_t:DEFINE_bake | apreq_cookie_bake (apreq_xs_sv2cookie(c), apreq_xs_sv2env(c))
| SV *:c
    apr_status_t:DEFINE_bake2| apreq_cookie_bake2(apreq_xs_sv2cookie(c), apreq_xs_sv2env(c))
| SV *:c
   
  
  
  

Mime
View raw message