Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Treat tied vars in the response properly

  • Loading branch information...
commit b80ead567b29eadac9913a227f458bb01af5adbf 1 parent 5bb12d3
@stash authored
Showing with 135 additions and 3 deletions.
  1. +9 −3 Feersum.xs
  2. +126 −0 t/09-magic.t
View
12 Feersum.xs
@@ -215,7 +215,10 @@ add_sv_to_wbuf(struct feer_conn *c, SV *sv)
struct iomatrix *m = next_iomatrix(c);
int idx = m->count++;
STRLEN cur;
- if (SvPADTMP(sv) || SvTEMP(sv)) {
+ if (SvMAGICAL(sv)) {
+ sv = newSVsv(sv); // copy to force it to be normal.
+ }
+ else if (SvPADTMP(sv) || SvTEMP(sv)) {
// PADTMPs have their PVs re-used, so we can't simply keep a
// reference. TEMPs maybe behave in a similar way and are potentially
// stealable.
@@ -1408,8 +1411,11 @@ feersum_write_whole_body (pTHX_ struct feer_conn *c, SV *body)
RETVAL = 0;
for (i=0; i<=amax; i++) {
SV **elt = av_fetch(abody, i, 0);
- if (elt == NULL || !SvOK(*elt)) continue;
- SV *sv = SvROK(*elt) ? SvRV(*elt) : *elt;
+ if (elt == NULL) continue;
+ SV *sv = *elt;
+ if (SvMAGICAL(sv)) sv = newSVsv(sv); // copy to remove magic
+ if (!SvOK(sv)) continue;
+ if (SvROK(sv)) sv = SvRV(sv);
cur = add_sv_to_wbuf(c,sv);
trace("body part i=%d sv=%p cur=%d\n", i, sv, cur);
RETVAL += cur;
View
126 t/09-magic.t
@@ -0,0 +1,126 @@
+#!perl
+use warnings;
+use strict;
+use Test::More tests => 25;
+use Test::Exception;
+use utf8;
+use lib 't'; use Utils;
+
+BEGIN { use_ok('Feersum') };
+
+my ($socket,$port) = get_listen_socket();
+ok $socket, "made listen socket";
+ok $socket->fileno, "has a fileno";
+
+my $evh = Feersum->new();
+$evh->use_socket($socket);
+
+{
+ package My::MagicScalar;
+ use Tie::Scalar;
+ use base 'Tie::StdScalar';
+ sub FETCH {
+ my $self = shift;
+ return uc($self->SUPER::FETCH(@_));
+ }
+}
+
+{
+ package My::MagicArray;
+ use Tie::Array;
+ use base 'Tie::StdArray';
+ sub FETCH {
+ my $self = shift;
+ my $e = $self->SUPER::FETCH(@_);
+ return ref($e) ? $e : uc($e);
+ }
+ sub SHIFT {
+ my $self = shift;
+ my $e = $self->SUPER::SHIFT(@_);
+ return ref($e) ? $e : uc($e);
+ }
+}
+
+$evh->request_handler(sub {
+ my $r = shift;
+ isa_ok $r, 'Feersum::Connection', 'got an object!';
+ my $env = $r->env();
+ ok $env, "got env";
+
+ my $type = $env->{HTTP_X_MAGIC_TYPE};
+ if ($type eq 'SCALAR') {
+ # magic scalar
+ tie my $ms, 'My::MagicScalar';
+ $ms = "foobar";
+ lives_ok(sub {
+ $r->send_response("200 OK", [
+ 'Content-Type' => 'text/plain',
+ ], \$ms);
+ }, "sent response for $type");
+ }
+ elsif ($type eq 'ARRAY') {
+ # magic array
+ tie my @ma, 'My::MagicArray';
+ @ma = ("aaaa","bbb");
+ lives_ok(sub {
+ $r->send_response("200 OK", [
+ 'Content-Type' => 'text/plain',
+ ], \@ma);
+ }, "sent response for $type");
+ }
+ else {
+ tie my $ms, 'My::MagicScalar';
+ $ms = "dddd";
+ tie my @ma, 'My::MagicArray';
+ @ma = ("cccc",\$ms);
+ lives_ok(sub {
+ $r->send_response("200 OK", [
+ 'Content-Type' => 'text/plain',
+ ], \@ma);
+ }, "sent response for $type");
+ }
+});
+
+my $cv = AE::cv;
+$cv->begin;
+
+my $w = simple_client GET => '/',
+ name => 'scalar',
+ headers => { 'X-Magic-Type' => 'SCALAR' },
+ timeout => 3,
+ sub {
+ my ($body, $hdr) = @_;
+ is $hdr->{Status}, 200, "client 1 got 200";
+ is $hdr->{'content-length'}, 6, 'content-length was overwritten by the engine';
+ is $body, 'FOOBAR', "magic body used for scalar";
+ $cv->end;
+ };
+
+$cv->begin;
+my $w2 = simple_client GET => '/',
+ name => 'array',
+ headers => { 'X-Magic-Type' => 'ARRAY' },
+ timeout => 3,
+ sub {
+ my ($body, $hdr) = @_;
+ is $hdr->{Status}, 200, "client 1 got 200";
+ is $hdr->{'content-length'}, 7, 'content-length';
+ is $body, 'AAAABBB', "magic body used for array";
+ $cv->end;
+ };
+
+$cv->begin;
+my $w3 = simple_client GET => '/',
+ name => 'array',
+ headers => { 'X-Magic-Type' => 'SCALAR-in-ARRAY' },
+ timeout => 3,
+ sub {
+ my ($body, $hdr) = @_;
+ is $hdr->{Status}, 200, "client 1 got 200";
+ is $hdr->{'content-length'}, 8, 'content-length';
+ is $body, 'CCCCDDDD', "magic body used for scalar in array";
+ $cv->end;
+ };
+
+$cv->recv;
+pass "all done";
Please sign in to comment.
Something went wrong with that request. Please try again.