root/lang/perl/HTTP-Engine/branches/shika/lib/HTTP/Engine/Response.pm @ 25216

Revision 25216, 3.1 kB (checked in by tokuhirom, 5 years ago)

oops

Line 
1package HTTP::Engine::Response;
2use Shika;
3
4use HTTP::Status ();
5use HTTP::Headers;
6use HTTP::Engine::Types;
7
8# Shika role merging is borked with attributes
9#with qw(HTTP::Engine::Response);
10
11sub BUILD {
12    my ( $self, $param ) = @_;
13
14    for my $field (qw(content_type)) {
15        if ( my $val = $param->{$field} ) {
16            $self->$field($val);
17        }
18    }
19}
20
21has body => (
22    is      => 'rw',
23    isa     => 'Any',
24    default => '',
25);
26sub content { shift->body(@_) } # alias
27
28has cookies => (
29    is      => 'rw',
30    isa     => 'HashRef',
31    default => sub { {} },
32);
33
34has protocol => (
35    is      => 'rw',
36#    isa     => 'Str',
37);
38
39has status => (
40    is      => 'rw',
41    isa     => 'Int',
42    default => 200,
43);
44
45sub code { shift->status(@_) }
46
47has headers => (
48    is      => 'rw',
49    # isa     => Header,
50    coerce  => \&coerce_headers,
51    default => sub { HTTP::Headers->new },
52    handles => [ qw(content_encoding content_length content_type header) ],
53);
54
55sub is_info     { HTTP::Status::is_info     (shift->status) }
56sub is_success  { HTTP::Status::is_success  (shift->status) }
57sub is_redirect { HTTP::Status::is_redirect (shift->status) }
58sub is_error    { HTTP::Status::is_error    (shift->status) }
59
60*output = \&body;
61
62sub set_http_response {
63    my ($self, $res) = @_;
64    $self->status( $res->code );
65    $self->headers( $res->headers->clone );
66    $self->body( $res->content );
67    $self;
68}
69
70sub as_http_response {
71    my $self = shift;
72
73    require HTTP::Response;
74    HTTP::Response->new(
75        $self->status,
76        '',
77        $self->headers->clone,
78        $self->body, # FIXME slurp file handles
79    );
80}
81
821;
83__END__
84
85=for stopwords URL
86
87=head1 NAME
88
89HTTP::Engine::Response - HTTP response object
90
91=head1 SYNOPSIS
92
93    sub handle_request {
94        my $req = shift;
95        my $res = HTTP::Engine::Response->new;
96        $res->body('foo');
97        return $res;
98    }
99
100=head1 ATTRIBUTES
101
102=over 4
103
104=item body
105
106Sets or returns the output (text or binary data). If you are returning a large body,
107you might want to use a L<IO::FileHandle> type of object (Something that implements the read method
108in the same fashion), or a filehandle GLOB. HTTP::Engine will write it piece by piece into the response.
109
110=item cookies
111
112
113Returns a reference to a hash containing cookies to be set. The keys of the
114hash are the cookies' names, and their corresponding values are hash
115references used to construct a L<CGI::Cookie> object.
116
117        $res->cookies->{foo} = { value => '123' };
118
119The keys of the hash reference on the right correspond to the L<CGI::Cookie>
120parameters of the same name, except they are used without a leading dash.
121Possible parameters are:
122
123=item status
124
125Sets or returns the HTTP status.
126
127    $res->status(404);
128
129=item headers
130
131Returns an L<HTTP::Headers> object, which can be used to set headers.
132
133    $res->headers->header( 'X-HTTP-Engine' => $HTTP::Engine::VERSION );
134
135=item set_http_response
136
137set a L<HTTP::Response> into $self.
138
139=back
140
141=head1 AUTHORS
142
143Kazuhiro Osawa and HTTP::Engine Authors.
144
145=head1 THANKS TO
146
147L<Catalyst::Response>
148
149=head1 SEE ALSO
150
151L<HTTP::Engine> L<HTTP::Response>, L<Catalyst::Response>
152
Note: See TracBrowser for help on using the browser.