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   741 use strict;
  3         7  
  3         88  
3 3     3   15 use warnings;
  3         6  
  3         73  
4 3     3   591 use utf8;
  3         19  
  3         13  
5 3     3   73 use Carp ();
  3         26  
  3         44  
6 3     3   524 use HTTP::Headers ();
  3         4399  
  3         1133  
7              
8             sub new {
9 4     4 0 3127 my $class = shift;
10 4 50       25 my %args = @_ == 1 ? %{$_[0]} : @_;
  0         0  
11 4 50       29 $args{code} || Carp::croak "Missing mandatory parameter: code";
12 4         21 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 51 my $self = shift;
24 4         21 delete $self->{headers};
25              
26             # Defence from HTTP Header Splitting.
27 4         9 my $code = delete $self->{code};
28             return sub {
29 4     4   47 my $responder = shift;
30             $code->(
31             sub {
32 4         25 my @copy = @{ $_[0]->[1] };
  4         24  
33 4         21 while (my (undef, $val) = splice(@copy, 0, 2)) {
34 5 100       37 if ($val =~ /[\000-\037]/) {
35 3         24 die("Response headers MUST NOT contain characters below octal \037\n");
36             }
37             }
38 1         3 return $responder->(@_);
39             }
40 4         17 );
41 4         27 };
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