Mercurial > pub > Impl
comparison Lib/IMPL/Web/Application/Response.pm @ 63:76b878ad6596
Added serialization support for the IMPL::Object::List
More intelligent Exception message
Fixed encoding support in the actions
Improoved tests
Minor fixes
author | wizard |
---|---|
date | Mon, 15 Mar 2010 02:38:09 +0300 |
parents | 0f3e369553bd |
children | 2840c4c85db8 |
comparison
equal
deleted
inserted
replaced
62:c64bd1bf727d | 63:76b878ad6596 |
---|---|
6 require IMPL::Exception; | 6 require IMPL::Exception; |
7 require CGI; | 7 require CGI; |
8 require CGI::Cookie; | 8 require CGI::Cookie; |
9 | 9 |
10 use Carp; | 10 use Carp; |
11 use Encode; | |
11 use IMPL::Class::Property; | 12 use IMPL::Class::Property; |
13 | |
14 #todo: add binary method to set a binary encoding, set it automatic when type isn't a text | |
12 | 15 |
13 BEGIN { | 16 BEGIN { |
14 public property query => prop_get | owner_set; # cgi query | 17 public property query => prop_get | owner_set; # cgi query |
15 public property status => prop_all, { validator => \&_checkHeaderPrinted }; | 18 public property status => prop_all, { validator => \&_checkHeaderPrinted }; |
16 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String | 19 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String |
31 | 34 |
32 sub CTOR { | 35 sub CTOR { |
33 my ($this,%args) = @_; | 36 my ($this,%args) = @_; |
34 | 37 |
35 $this->query(CGI->new($this->query() | {})) unless $this->query; | 38 $this->query(CGI->new($this->query() | {})) unless $this->query; |
36 $this->charset($this->query->charset) unless $this->charset; | |
37 | 39 |
38 $this->streamOut(*STDOUT) unless $this->streamOut; | 40 $this->streamOut(*STDOUT) unless $this->streamOut; |
41 $this->buffered(1) unless defined $this->buffered; | |
42 binmode $this->streamOut, ":encoding(".$this->charset.")"; | |
39 } | 43 } |
40 | 44 |
41 sub _checkHeaderPrinted { | 45 sub _checkHeaderPrinted { |
42 my ($this,$value) = @_; | 46 my ($this,$value) = @_; |
43 | 47 |
51 } | 55 } |
52 | 56 |
53 sub _charset { | 57 sub _charset { |
54 my $this = shift; | 58 my $this = shift; |
55 | 59 |
56 return $this->query->charset(@_); | 60 if (@_) { |
61 my $charset = $this->query->charset(@_); | |
62 | |
63 my $hout = $this->streamOut; | |
64 | |
65 binmode $hout; | |
66 binmode $hout, ":encoding($charset)"; | |
67 | |
68 return $charset; | |
69 } else { | |
70 return $this->query->charset; | |
71 } | |
57 } | 72 } |
58 | 73 |
59 sub _PrintHeader { | 74 sub _PrintHeader { |
60 my ($this) = @_; | 75 my ($this) = @_; |
61 | 76 |
85 return undef unless $this->streamOut; | 100 return undef unless $this->streamOut; |
86 | 101 |
87 unless ($this->_streamBody) { | 102 unless ($this->_streamBody) { |
88 if ($this->buffered) { | 103 if ($this->buffered) { |
89 my $buffer = ""; | 104 my $buffer = ""; |
105 | |
90 $this->_bufferBody(\$buffer); | 106 $this->_bufferBody(\$buffer); |
91 | 107 |
92 open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!); | 108 open my $hBody, ">:encoding(utf-8)", \$buffer or die new IMPL::Exception("Failed to create buffer",$!); |
109 | |
110 Encode::_utf8_on($buffer); | |
93 | 111 |
94 $this->_streamBody($hBody); | 112 $this->_streamBody($hBody); |
95 } else { | 113 } else { |
96 $this->_PrintHeader(); | 114 $this->_PrintHeader(); |
97 $this->_streamBody($this->streamOut); | 115 $this->_streamBody($this->streamOut); |
108 | 126 |
109 my $hOut = $this->streamOut; | 127 my $hOut = $this->streamOut; |
110 | 128 |
111 $this->_PrintHeader(); | 129 $this->_PrintHeader(); |
112 | 130 |
131 $this->_streamBody(undef); | |
132 | |
113 if ($this->buffered) { | 133 if ($this->buffered) { |
114 print $hOut ${$this->_bufferBody}; | 134 print $hOut ${$this->_bufferBody}; |
115 } | 135 } |
136 | |
137 $this->_bufferBody(undef); | |
138 $this->streamOut(undef); | |
139 | |
140 return 1; | |
141 } | |
142 | |
143 sub Discard { | |
144 my ($this) = @_; | |
145 | |
146 carp "Discarding sent response" if $this->isHeaderPrinted; | |
116 | 147 |
117 $this->_streamBody(undef); | 148 $this->_streamBody(undef); |
118 $this->_bufferBody(undef); | 149 $this->_bufferBody(undef); |
119 $this->streamOut(undef); | 150 $this->streamOut(undef); |
120 | |
121 return 1; | |
122 } | |
123 | |
124 sub Discard { | |
125 my ($this) = @_; | |
126 | |
127 carp "Discarding sent response" if $this->isHeaderPrinted; | |
128 | |
129 $this->_streamBody(undef); | |
130 $this->_bufferBody(undef); | |
131 $this->streamOut(undef); | |
132 } | 151 } |
133 | 152 |
134 1; | 153 1; |
135 | 154 |
136 __END__ | 155 __END__ |