File Coverage

blib/lib/Amon2/Web/Response/Callback.pm
Criterion Covered Total %
statement 31 35 88.5
branch 4 6 66.6
condition n/a
subroutine 8 10 80.0
pod 0 4 0.0
total 43 55 78.1


line stmt bran cond sub pod time code
1             package Amon2::Web::Response::Callback;
2 3     3   451 use strict;
  3         6  
  3         88  
3 3     3   14 use warnings;
  3         5  
  3         66  
4 3     3   587 use utf8;
  3         19  
  3         14  
5 3     3   66 use Carp ();
  3         6  
  3         51  
6 3     3   502 use HTTP::Headers ();
  3         7841  
  3         1110  
7              
8             sub new {
9 4     4 0 3162 my $class = shift;
10 4 50       18 my %args = @_ == 1 ? %{$_[0]} : @_;
  0         0  
11 4 50       13 $args{code} || Carp::croak "Missing mandatory parameter: code";
12 4         28 bless {
13             headers => HTTP::Headers->new,
14             %args
15             }, $class;
16             }
17             sub header {
18 0     0 0 0 my $self = shift;
19 0         0 $self->headers->header(@_);
20             }
21 0     0 0 0 sub headers { $_[0]->{headers} }
22             sub finalize {
23 4     4 0 83 my $self = shift;
24 4         21 delete $self->{headers};
25              
26             # Defence from HTTP Header Splitting.
27 4         10 my $code = delete $self->{code};
28             return sub {
29 4     4   26 my $responder = shift;
30             $code->(
31             sub {
32 4         23 my @copy = @{ $_[0]->[1] };
  4         25  
33 4         19 while (my (undef, $val) = splice(@copy, 0, 2)) {
34 5 100       30 if ($val =~ /[\000-\037]/) {
35 3         20 die("Response headers MUST NOT contain characters below octal \037\n");
36             }
37             }
38 1         4 return $responder->(@_);
39             }
40 4         28 );
41 4         26 };
42             }
43              
44              
45             1;
46             __END__
47              
48             =head1 NAME
49              
50             Amon2::Web::Response::Callback - [EXPERIMENTAL]callback style psgi response for Amon2
51              
52             =head1 SYNOPSIS
53              
54             use Amon2::Lite;
55              
56             any '/cb' => sub {
57             my $c = shift;
58             Amon2::Web::Response::Callback->new(
59             code => sub {
60             my $respond = shift;
61             $respond->([200, [], []]);
62             }
63             );
64             };
65              
66             =head1 DESCRIPTION
67              
68             This module provides a response object for delayed response/streaming body.
69              
70             You can embed the AE support, streaming support, etc on Amon2 with this module.
71              
72             =head1 SEE ALSO
73              
74             L<Tatsumaki>
75