You are viewing a plain text version of this content. The canonical link for it is here.
Posted to apreq-cvs@httpd.apache.org by jo...@apache.org on 2003/07/13 07:03:49 UTC
cvs commit: httpd-apreq-2/glue/perl/xsbuilder/maps apreq_functions.map
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