File Coverage

blib/lib/AnyEvent/HTTPD/SendMultiHeaderPatch.pm
Criterion Covered Total %
statement 26 77 33.7
branch 0 38 0.0
condition 0 12 0.0
subroutine 9 14 64.2
pod n/a
total 35 141 24.8


line stmt bran cond sub pod time code
1             package AnyEvent::HTTPD::SendMultiHeaderPatch;
2              
3 1     1   12622 use 5.006;
  1         2  
4 1     1   3 use strict;
  1         0  
  1         17  
5 1     1   2 use warnings FATAL => 'all';
  1         4  
  1         29  
6 1     1   2 no warnings 'redefine';
  1         2  
  1         21  
7              
8 1     1   433 use AnyEvent::HTTPD::HTTPConnection;
  1         44439  
  1         39  
9              
10             =head1 NAME
11              
12             AnyEvent::HTTPD::SendMultiHeaderPatch -
13             Patch (hack) of AnyEvent::HTTPD for sending multiple headers with the same field name.
14              
15             =head1 VERSION
16              
17             Version 0.1.3
18              
19             =cut
20              
21             our $VERSION = '0.001003';
22              
23 1     1   509 use AnyEvent::HTTPD;
  1         7710  
  1         23  
24 1     1   4 use AnyEvent::HTTPD::Util;
  1         2  
  1         52  
25 1     1   3 use AnyEvent::HTTPD::HTTPConnection;
  1         1  
  1         15  
26              
27 1     1   3 use Scalar::Util qw(weaken);
  1         1  
  1         520  
28              
29             push @AnyEvent::HTTPD::Util::EXPORT, qw(header_add header_gets);
30              
31             *AnyEvent::HTTPD::Util::header_add = sub {
32 0     0     my ($hdrs, $name, $value) = @_;
33 0           $name = AnyEvent::HTTPD::Util::_header_transform_case_insens ($hdrs, $name);
34 0 0         if( exists $hdrs->{$name} ) {
35 0           $hdrs->{$name} .= "\0".$value;
36             }
37             else {
38 0           $hdrs->{$name} = $value;
39             }
40             };
41              
42             *AnyEvent::HTTPD::Util::header_gets = sub {
43 0     0     my ($hdrs, $name) = @_;
44 0           $name = AnyEvent::HTTPD::Util::_header_transform_case_insens ($hdrs, $name);
45 0 0         exists $hdrs->{$name} ? [split /\0/, $hdrs->{$name}] : []
46             };
47              
48             *AnyEvent::HTTPD::HTTPConnection::response = sub {
49 0     0     my ($self, $code, $msg, $hdr, $content, $no_body) = @_;
50 0 0         return if $self->{disconnected};
51 0 0         return unless $self->{hdl};
52              
53 0           my $res = "HTTP/1.0 $code $msg\015\012";
54 0 0         header_set ($hdr, 'Date' => AnyEvent::HTTPD::HTTPConnection::_time_to_http_date time)
55             unless header_exists ($hdr, 'Date');
56 0 0         header_set ($hdr, 'Expires' => header_get ($hdr, 'Date'))
57             unless header_exists ($hdr, 'Expires');
58 0 0         header_set ($hdr, 'Cache-Control' => "max-age=0")
59             unless header_exists ($hdr, 'Cache-Control');
60             header_set ($hdr, 'Connection' =>
61 0 0         ($self->{keep_alive} ? 'Keep-Alive' : 'close'));
62              
63 0 0 0       header_set ($hdr, 'Content-Length' => length "$content")
64             unless header_exists ($hdr, 'Content-Length')
65             || ref $content;
66              
67 0 0         unless (defined header_get ($hdr, 'Content-Length')) {
68             # keep alive with no content length will NOT work.
69 0           delete $self->{keep_alive};
70 0           header_set ($hdr, 'Connection' => 'close');
71             }
72              
73 0           while (my ($h, $v) = each %$hdr) {
74 0 0         next unless defined $v;
75 0           for my $vv ( split /\0/, $v ) {
76 0           $res .= "$h: $vv\015\012";
77             }
78             }
79              
80 0           $res .= "\015\012";
81              
82 0 0         if ($no_body) { # for HEAD requests!
83 0           $self->{hdl}->push_write ($res);
84 0           $self->response_done;
85 0           return;
86             }
87              
88 0 0         if (ref ($content) eq 'CODE') {
89 0           weaken $self;
90              
91             my $chunk_cb = sub {
92 0     0     my ($chunk) = @_;
93              
94 0 0 0       return 0 unless defined ($self) && defined ($self->{hdl}) && !$self->{disconnected};
      0        
95              
96 0           delete $self->{transport_polled};
97              
98 0 0 0       if (defined ($chunk) && length ($chunk) > 0) {
99 0           $self->{hdl}->push_write ($chunk);
100              
101             } else {
102 0           $self->response_done;
103             }
104              
105 0           return 1;
106 0           };
107              
108 0           $self->{transfer_cb} = $content;
109              
110             $self->{hdl}->on_drain (sub {
111 0 0   0     return unless $self;
112              
113 0 0         if (length $res) {
    0          
114 0           my $r = $res;
115 0           undef $res;
116 0           $chunk_cb->($r);
117              
118             } elsif (not $self->{transport_polled}) {
119 0           $self->{transport_polled} = 1;
120 0 0         $self->{transfer_cb}->($chunk_cb) if $self;
121             }
122 0           });
123              
124             } else {
125 0           $res .= $content;
126 0           $self->{hdl}->push_write ($res);
127 0           $self->response_done;
128             }
129             };
130              
131             =head1 SYNOPSIS
132              
133             use AnyEvent::HTTPD; # Optional,
134             # because the patch module will use it first.
135             use AnyEvent::HTTPD::SendMultiHeaderPatch;
136              
137             # In the http request handler,
138             # separate the multiple values of the same field with \0 character.
139             sub {
140             my($httpd, $req) = @_;
141             # ...
142             $req->respond(
143             200, 'OK', {
144             'Set-Cookie' => "a=123; path=/; domain=.example.com\0b=456; path=/; domain=.example.com"
145             }, "Set the cookies"
146             );
147             }
148              
149             # Or use the added util function header_add in AnyEvent::HTTPD::Util.
150             use AnyEvent::HTTPD::Util;
151              
152             sub {
153             my($httpd, $req) = @_;
154             # ...
155             my %header;
156             header_add(\%header, 'Set-Cookie', 'a=123; path=/; domain=.example.com');
157             header_add(\%header, 'Set-Cookie', 'b=456; path=/; domain=.example.com');
158             $req->respond(200, 'OK', \%header, "Set the cookies");
159             }
160              
161             # There also introduced another util function header_gets in AnyEvent::HTTPD::Util,
162             # to extract multiple values in the header
163             sub {
164             my($httpd, $req) = @_;
165             # ...
166             my %header;
167             header_add(\%header, 'Example', 'a');
168             header_add(\%header, 'Example', 'b');
169              
170             my $example_values = header_gets(\%header, 'Example');
171             # get ['a', 'b']
172             my $no_values = header_gets(\%header, 'None');
173             # get []
174             }
175              
176              
177             =head1 CAVEATS
178              
179             =over 4
180              
181             =item This is a hack (should be stable)
182              
183             This module is a hack patch that replace the method 'response' in package AnyEvent::HTTPD::HTTPConnection.
184             I think that it's still stable since the module AnyEvent::HTTPD has been frozen since 2011.3 (Today is 2013.4)
185              
186             =item No \0 in your header values
187              
188             Don't use \0 in your header values since it's used as the separater.
189              
190             =back
191              
192             =head1 AUTHOR
193              
194             Cindy Wang (CindyLinz)
195              
196             =head1 LICENSE AND COPYRIGHT
197              
198             Copyright 2013 Cindy Wang (CindyLinz).
199              
200             This program is free software; you can redistribute it and/or modify it
201             under the terms of the the Artistic License (2.0). You may obtain a
202             copy of the full license at:
203              
204             L
205              
206             Any use, modification, and distribution of the Standard or Modified
207             Versions is governed by this Artistic License. By using, modifying or
208             distributing the Package, you accept this license. Do not use, modify,
209             or distribute the Package, if you do not accept this license.
210              
211             If your Modified Version has been derived from a Modified Version made
212             by someone other than you, you are nevertheless required to ensure that
213             your Modified Version complies with the requirements of this license.
214              
215             This license does not grant you the right to use any trademark, service
216             mark, tradename, or logo of the Copyright Holder.
217              
218             This license includes the non-exclusive, worldwide, free-of-charge
219             patent license to make, have made, use, offer to sell, sell, import and
220             otherwise transfer the Package with respect to any patent claims
221             licensable by the Copyright Holder that are necessarily infringed by the
222             Package. If you institute patent litigation (including a cross-claim or
223             counterclaim) against any party alleging that the Package constitutes
224             direct or contributory patent infringement, then this Artistic License
225             to you shall terminate on the date that such litigation is filed.
226              
227             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
228             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
229             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
230             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
231             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
232             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
233             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
234             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
235              
236              
237             =cut
238              
239             1; # End of AnyEvent::HTTPD::SendMultiHeaderPatch