[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine.pm

package Catalyst::Engine;

use strict;
use base 'Class::Accessor::Fast';
use CGI::Cookie;
use Data::Dumper;
use HTML::Entities;
use HTTP::Body;
use HTTP::Headers;
use URI::QueryParam;

# input position and length
__PACKAGE__->mk_accessors(qw/read_position read_length/);

# Stringify to class
use overload '""' => sub { return ref shift }, fallback => 1;

# Amount of data to read from input on each pass
our $CHUNKSIZE = 4096;

=head1 NAME

Catalyst::Engine - The Catalyst Engine

=head1 SYNOPSIS

See L<Catalyst>.

=head1 DESCRIPTION

=head1 METHODS

=over 4

=item $self->finalize_output

<obsolete>, see finalize_body

=item $self->finalize_body($c)

Finalize body.  Prints the response output.

=cut

sub finalize_body {
    my ( $self, $c ) = @_;
    if ( ref $c->response->body && $c->response->body->can('read') ) {
        while ( !$c->response->body->eof() ) {
            $c->response->body->read( my $buffer, $CHUNKSIZE );
            last unless $self->write( $c, $buffer );
        }
        $c->response->body->close();
    }
    else {
        $self->write( $c, $c->response->body );
    }
}

=item $self->finalize_cookies($c)

=cut

sub finalize_cookies {
    my ( $self, $c ) = @_;

    my @cookies;
    while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {

        my $cookie = CGI::Cookie->new(
            -name    => $name,
            -value   => $cookie->{value},
            -expires => $cookie->{expires},
            -domain  => $cookie->{domain},
            -path    => $cookie->{path},
            -secure  => $cookie->{secure} || 0
        );

        push @cookies, $cookie->as_string;
    }

    if (@cookies) {
        $c->res->headers->push_header( 'Set-Cookie' => join ',', @cookies );
    }
}

=item $self->finalize_error($c)

=cut

sub finalize_error {
    my ( $self, $c ) = @_;

    $c->res->content_type('text/html; charset=utf-8');
    my $name = $c->config->{name} || 'Catalyst Application';

    my ( $title, $error, $infos );
    if ( $c->debug ) {

        # For pretty dumps
        local $Data::Dumper::Terse = 1;
        $error = join '',
          map { '<p><code class="error">' . encode_entities($_) . '</code></p>' }
          @{ $c->error };
        $error ||= 'No output';
        $title = $name = "$name on Catalyst $Catalyst::VERSION";
        $name = "<h1>$name</h1>";

        # Don't show context in the dump
        delete $c->req->{_context};
        delete $c->res->{_context};

        # Don't show body parser in the dump
        delete $c->req->{_body};

        # Don't show response header state in dump
        delete $c->res->{_finalized_headers};

        my $req   = encode_entities Dumper $c->req;
        my $res   = encode_entities Dumper $c->res;
        my $stash = encode_entities Dumper $c->stash;

        my @infos;
        my $i = 0;
        for my $dump ( $c->dump_these ) {
            my $name  = $dump->[0];
            my $value = encode_entities( Dumper $dump->[1] );
            push @infos, sprintf <<"EOF", $name, $value;
<h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
<div id="dump_$i">
    <pre>%s</pre>
</div>
EOF
            $i++;
        }
        $infos = join "\n", @infos;
    }
    else {
        $title = $name;
        $error = '';
        $infos = <<"";
<pre>
(en) Please come back later
(de) Bitte versuchen sie es spaeter nocheinmal
(nl) Gelieve te komen later terug
(no) Vennligst prov igjen senere
(fr) Veuillez revenir plus tard
(es) Vuelto por favor mas adelante
(pt) Voltado por favor mais tarde
(it) Ritornato prego più successivamente
</pre>

        $name = '';
    }
    $c->res->body( <<"" );
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
    <meta http-equiv="Content-Language" content="en" />
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <title>$title</title>
    <script type="text/javascript">
        <!--
        function toggleDump (dumpElement) {
            var e = document.getElementById( dumpElement );
            if (e.style.display == "none") {
                e.style.display = "";
            }
            else {
                e.style.display = "none";
            }
        }
        -->
    </script>
    <style type="text/css">
        body {
            font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
                         Tahoma, Arial, helvetica, sans-serif;
            color: #ddd;
            background-color: #eee;
            margin: 0px;
            padding: 0px;
        }
        :link, :link:hover, :visited, :visited:hover {
            color: #ddd;
        }
        div.box {
            position: relative;
            background-color: #ccc;
            border: 1px solid #aaa;
            padding: 4px;
            margin: 10px;
            -moz-border-radius: 10px;
        }
        div.error {
            background-color: #977;
            border: 1px solid #755;
            padding: 8px;
            margin: 4px;
            margin-bottom: 10px;
            -moz-border-radius: 10px;
        }
        div.infos {
            background-color: #797;
            border: 1px solid #575;
            padding: 8px;
            margin: 4px;
            margin-bottom: 10px;
            -moz-border-radius: 10px;
        }
        div.name {
            background-color: #779;
            border: 1px solid #557;
            padding: 8px;
            margin: 4px;
            -moz-border-radius: 10px;
        }
        code.error {
            display: block;
            margin: 1em 0;
            overflow: auto;
            white-space: pre;
        }
        div.name h1, div.error p {
            margin: 0;
        }
        h2 {
            margin-top: 0;
            margin-bottom: 10px;
            font-size: medium;
            font-weight: bold;
            text-decoration: underline;
        }
        h1 {
            font-size: medium;
            font-weight: normal;
        }
    </style>
</head>
<body>
    <div class="box">
        <div class="error">$error</div>
        <div class="infos">$infos</div>
        <div class="name">$name</div>
    </div>
</body>
</html>

}

=item $self->finalize_headers($c)

=cut

sub finalize_headers { }

=item $self->finalize_read($c)

=cut

sub finalize_read {
    my ( $self, $c ) = @_;

    undef $self->{_prepared_read};
}

=item $self->finalize_uploads($c)

=cut

sub finalize_uploads {
    my ( $self, $c ) = @_;

    if ( keys %{ $c->request->uploads } ) {
        for my $key ( keys %{ $c->request->uploads } ) {
            my $upload = $c->request->uploads->{$key};
            unlink map { $_->tempname }
              grep     { -e $_->tempname }
              ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
        }
    }
}

=item $self->prepare_body($c)

=cut

sub prepare_body {
    my ( $self, $c ) = @_;

    $self->read_length( $c->request->header('Content-Length') || 0 );
    my $type = $c->request->header('Content-Type');

    unless ( $c->request->{_body} ) {
        $c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
    }

    if ( $self->read_length > 0 ) {
        while ( my $buffer = $self->read($c) ) {
            $c->prepare_body_chunk($buffer);
        }
    }
}

=item $self->prepare_body_chunk($c)

=cut

sub prepare_body_chunk {
    my ( $self, $c, $chunk ) = @_;

    $c->request->{_body}->add($chunk);
}

=item $self->prepare_body_parameters($c)

=cut

sub prepare_body_parameters {
    my ( $self, $c ) = @_;
    $c->request->body_parameters( $c->request->{_body}->param );
}

=item $self->prepare_connection($c)

=cut

sub prepare_connection { }

=item $self->prepare_cookies($c)

=cut

sub prepare_cookies {
    my ( $self, $c ) = @_;

    if ( my $header = $c->request->header('Cookie') ) {
        $c->req->cookies( { CGI::Cookie->parse($header) } );
    }
}

=item $self->prepare_headers($c)

=cut

sub prepare_headers { }

=item $self->prepare_parameters($c)

=cut

sub prepare_parameters {
    my ( $self, $c ) = @_;

    # We copy, no references
    while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
        $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
        $c->request->parameters->{$name} = $param;
    }

    # Merge query and body parameters
    while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
        $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
        if ( my $old_param = $c->request->parameters->{$name} ) {
            if ( ref $old_param eq 'ARRAY' ) {
                push @{ $c->request->parameters->{$name} },
                  ref $param eq 'ARRAY' ? @$param : $param;
            }
            else { $c->request->parameters->{$name} = [ $old_param, $param ] }
        }
        else { $c->request->parameters->{$name} = $param }
    }
}

=item $self->prepare_path($c)

=cut

sub prepare_path { }

=item $self->prepare_request($c)

=item $self->prepare_query_parameters($c)

=cut

sub prepare_query_parameters {
    my ( $self, $c, $query_string ) = @_;

    # replace semi-colons
    $query_string =~ s/;/&/g;

    my $u = URI->new( '', 'http' );
    $u->query($query_string);
    for my $key ( $u->query_param ) {
        my @vals = $u->query_param($key);
        $c->request->query_parameters->{$key} = @vals > 1 ? [@vals] : $vals[0];
    }
}

=item $self->prepare_read($c)

=cut

sub prepare_read {
    my ( $self, $c ) = @_;

    # Reset the read position
    $self->read_position(0);
}

=item $self->prepare_request(@arguments)

=cut

sub prepare_request { }

=item $self->prepare_uploads($c)

=cut

sub prepare_uploads {
    my ( $self, $c ) = @_;
    my $uploads = $c->request->{_body}->upload;
    for my $name ( keys %$uploads ) {
        my $files = $uploads->{$name};
        $files = ref $files eq 'ARRAY' ? $files : [$files];
        my @uploads;
        for my $upload (@$files) {
            my $u = Catalyst::Request::Upload->new;
            $u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
            $u->type( $u->headers->content_type );
            $u->tempname( $upload->{tempname} );
            $u->size( $upload->{size} );
            $u->filename( $upload->{filename} );
            push @uploads, $u;
        }
        $c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];

        # support access to the filename as a normal param
        my @filenames = map { $_->{filename} } @uploads;
        $c->request->parameters->{$name} =
          @filenames > 1 ? \@filenames : $filenames[0];
    }
}

=item $self->prepare_write($c)

=cut

sub prepare_write { }

=item $self->read($c, [$maxlength])

=cut

sub read {
    my ( $self, $c, $maxlength ) = @_;

    unless ( $self->{_prepared_read} ) {
        $self->prepare_read($c);
        $self->{_prepared_read} = 1;
    }

    my $remaining = $self->read_length - $self->read_position;
    $maxlength ||= $CHUNKSIZE;

    # Are we done reading?
    if ( $remaining <= 0 ) {
        $self->finalize_read($c);
        return;
    }

    my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
    my $rc = $self->read_chunk( $c, my $buffer, $readlen );
    if ( defined $rc ) {
        $self->read_position( $self->read_position + $rc );
        return $buffer;
    }
    else {
        Catalyst::Exception->throw(
            message => "Unknown error reading input: $!" );
    }
}

=item $self->read_chunk($c, $buffer, $length)

Each engine inplements read_chunk as its preferred way of reading a chunk
of data.

=cut

sub read_chunk { }

=item $self->read_length

The length of input data to be read.  This is obtained from the Content-Length
header.

=item $self->read_position

The amount of input data that has already been read.

=item $self->run($c)

=cut

sub run { }

=item $self->write($c, $buffer)

=cut

sub write {
    my ( $self, $c, $buffer ) = @_;

    unless ( $self->{_prepared_write} ) {
        $self->prepare_write($c);
        $self->{_prepared_write} = 1;
    }

    print STDOUT $buffer;
}

=back

=head1 AUTHORS

Sebastian Riedel, <sri@cpan.org>

Andy Grundman, <andy@hybridized.org>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
Commit	Line	Data
fc7ec1d9	1	package Catalyst::Engine;
	2
	3	use strict;
fbcc39ad	4	use base 'Class::Accessor::Fast';
6dc87a0f	5	use CGI::Cookie;
fc7ec1d9	6	use Data::Dumper;
fc7ec1d9	7	use HTML::Entities;
fbcc39ad	8	use HTTP::Body;
fc7ec1d9	9	use HTTP::Headers;
e0616220	10	use URI::QueryParam;
fbcc39ad	11
fbcc39ad	12	# input position and length
4f5ebacd	13	__PACKAGE__->mk_accessors(qw/read_position read_length/);
fbcc39ad	14
	15	# Stringify to class
	16	use overload '""' => sub { return ref shift }, fallback => 1;
fc7ec1d9	17
4bd82c41	18	# Amount of data to read from input on each pass
	19	our $CHUNKSIZE = 4096;
	20
fc7ec1d9	21	=head1 NAME
	22
	23	Catalyst::Engine - The Catalyst Engine
	24
	25	=head1 SYNOPSIS
	26
	27	See L<Catalyst>.
	28
	29	=head1 DESCRIPTION
	30
23f9d934	31	=head1 METHODS
fc7ec1d9	32
23f9d934	33	=over 4
23f9d934	34
fbcc39ad	35	=item $self->finalize_output
cd3bb248	36
	37	<obsolete>, see finalize_body
	38
fbcc39ad	39	=item $self->finalize_body($c)
06e1b616	40
fbcc39ad	41	Finalize body. Prints the response output.
06e1b616	42
	43	=cut
	44
fbcc39ad	45	sub finalize_body {
fbcc39ad	46	my ( $self, $c ) = @_;
f4a57de4	47	if ( ref $c->response->body && $c->response->body->can('read') ) {
f4a57de4	48	while ( !$c->response->body->eof() ) {
6e692ab4	49	$c->response->body->read( my $buffer, $CHUNKSIZE );
6484fba0	50	last unless $self->write( $c, $buffer );
f4a57de4	51	}
6e692ab4	52	$c->response->body->close();
f4a57de4	53	}
f4a57de4	54	else {
6e692ab4	55	$self->write( $c, $c->response->body );
f4a57de4	56	}
fbcc39ad	57	}
6dc87a0f	58
fbcc39ad	59	=item $self->finalize_cookies($c)
6dc87a0f	60
	61	=cut
	62
	63	sub finalize_cookies {
fbcc39ad	64	my ( $self, $c ) = @_;
6dc87a0f	65
fbcc39ad	66	my @cookies;
6dc87a0f	67	while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
fbcc39ad	68
6dc87a0f	69	my $cookie = CGI::Cookie->new(
	70	-name => $name,
	71	-value => $cookie->{value},
	72	-expires => $cookie->{expires},
	73	-domain => $cookie->{domain},
	74	-path => $cookie->{path},
	75	-secure => $cookie->{secure} \|\| 0
	76	);
	77
fbcc39ad	78	push @cookies, $cookie->as_string;
6dc87a0f	79	}
6dc87a0f	80
fbcc39ad	81	if (@cookies) {
	82	$c->res->headers->push_header( 'Set-Cookie' => join ',', @cookies );
	83	}
	84	}
969647fd	85
fbcc39ad	86	=item $self->finalize_error($c)
969647fd	87
	88	=cut
	89
	90	sub finalize_error {
fbcc39ad	91	my ( $self, $c ) = @_;
969647fd	92
7299a7b4	93	$c->res->content_type('text/html; charset=utf-8');
969647fd	94	my $name = $c->config->{name} \|\| 'Catalyst Application';
	95
	96	my ( $title, $error, $infos );
	97	if ( $c->debug ) {
62d9b030	98
	99	# For pretty dumps
	100	local $Data::Dumper::Terse = 1;
	101	$error = join '',
9619f23c	102	map { '<p><code class="error">' . encode_entities($_) . '</code></p>' }
62d9b030	103	@{ $c->error };
969647fd	104	$error \|\|= 'No output';
969647fd	105	$title = $name = "$name on Catalyst $Catalyst::VERSION";
9619f23c	106	$name = "<h1>$name</h1>";
fbcc39ad	107
	108	# Don't show context in the dump
	109	delete $c->req->{_context};
	110	delete $c->res->{_context};
	111
	112	# Don't show body parser in the dump
	113	delete $c->req->{_body};
	114
	115	# Don't show response header state in dump
	116	delete $c->res->{_finalized_headers};
	117
969647fd	118	my $req = encode_entities Dumper $c->req;
	119	my $res = encode_entities Dumper $c->res;
	120	my $stash = encode_entities Dumper $c->stash;
969647fd	121
c6ef5e69	122	my @infos;
c6ef5e69	123	my $i = 0;
c6ef5e69	124	for my $dump ( $c->dump_these ) {
c6ef5e69	125	my $name = $dump->[0];
	126	my $value = encode_entities( Dumper $dump->[1] );
	127	push @infos, sprintf <<"EOF", $name, $value;
9619f23c	128	<h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
c6ef5e69	129	<div id="dump_$i">
	130	<pre>%s</pre>
	131	</div>
	132	EOF
	133	$i++;
	134	}
	135	$infos = join "\n", @infos;
969647fd	136	}
	137	else {
	138	$title = $name;
	139	$error = '';
	140	$infos = <<"";
	141	<pre>
	142	(en) Please come back later
	143	(de) Bitte versuchen sie es spaeter nocheinmal
	144	(nl) Gelieve te komen later terug
	145	(no) Vennligst prov igjen senere
	146	(fr) Veuillez revenir plus tard
	147	(es) Vuelto por favor mas adelante
	148	(pt) Voltado por favor mais tarde
fbcc39ad	149	(it) Ritornato prego più successivamente
969647fd	150	</pre>
	151
	152	$name = '';
	153	}
e060fe05	154	$c->res->body( <<"" );
7299a7b4	155	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
	156	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
	157	<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
969647fd	158	<head>
7299a7b4	159	<meta http-equiv="Content-Language" content="en" />
7299a7b4	160	<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
969647fd	161	<title>$title</title>
7299a7b4	162	<script type="text/javascript">
c6ef5e69	163	<!--
c6ef5e69	164	function toggleDump (dumpElement) {
7299a7b4	165	var e = document.getElementById( dumpElement );
	166	if (e.style.display == "none") {
	167	e.style.display = "";
c6ef5e69	168	}
c6ef5e69	169	else {
7299a7b4	170	e.style.display = "none";
c6ef5e69	171	}
	172	}
	173	-->
	174	</script>
969647fd	175	<style type="text/css">
	176	body {
	177	font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
	178	Tahoma, Arial, helvetica, sans-serif;
	179	color: #ddd;
	180	background-color: #eee;
	181	margin: 0px;
	182	padding: 0px;
	183	}
c6ef5e69	184	:link, :link:hover, :visited, :visited:hover {
	185	color: #ddd;
	186	}
969647fd	187	div.box {
9619f23c	188	position: relative;
969647fd	189	background-color: #ccc;
	190	border: 1px solid #aaa;
	191	padding: 4px;
	192	margin: 10px;
	193	-moz-border-radius: 10px;
	194	}
	195	div.error {
	196	background-color: #977;
	197	border: 1px solid #755;
	198	padding: 8px;
	199	margin: 4px;
	200	margin-bottom: 10px;
	201	-moz-border-radius: 10px;
	202	}
	203	div.infos {
	204	background-color: #797;
	205	border: 1px solid #575;
	206	padding: 8px;
	207	margin: 4px;
	208	margin-bottom: 10px;
	209	-moz-border-radius: 10px;
	210	}
	211	div.name {
	212	background-color: #779;
	213	border: 1px solid #557;
	214	padding: 8px;
	215	margin: 4px;
	216	-moz-border-radius: 10px;
	217	}
7f8e0078	218	code.error {
	219	display: block;
	220	margin: 1em 0;
	221	overflow: auto;
	222	white-space: pre;
	223	}
9619f23c	224	div.name h1, div.error p {
	225	margin: 0;
	226	}
	227	h2 {
	228	margin-top: 0;
	229	margin-bottom: 10px;
	230	font-size: medium;
	231	font-weight: bold;
	232	text-decoration: underline;
	233	}
	234	h1 {
	235	font-size: medium;
	236	font-weight: normal;
	237	}
969647fd	238	</style>
	239	</head>
	240	<body>
	241	<div class="box">
	242	<div class="error">$error</div>
	243	<div class="infos">$infos</div>
	244	<div class="name">$name</div>
	245	</div>
	246	</body>
	247	</html>
	248
	249	}
	250
fbcc39ad	251	=item $self->finalize_headers($c)
fc7ec1d9	252
	253	=cut
	254
	255	sub finalize_headers { }
	256
fbcc39ad	257	=item $self->finalize_read($c)
fc7ec1d9	258
	259	=cut
	260
fbcc39ad	261	sub finalize_read {
fbcc39ad	262	my ( $self, $c ) = @_;
4f5ebacd	263
fbcc39ad	264	undef $self->{_prepared_read};
fc7ec1d9	265	}
fc7ec1d9	266
fbcc39ad	267	=item $self->finalize_uploads($c)
fc7ec1d9	268
	269	=cut
	270
fbcc39ad	271	sub finalize_uploads {
fbcc39ad	272	my ( $self, $c ) = @_;
99fe1710	273
fbcc39ad	274	if ( keys %{ $c->request->uploads } ) {
	275	for my $key ( keys %{ $c->request->uploads } ) {
	276	my $upload = $c->request->uploads->{$key};
	277	unlink map { $_->tempname }
	278	grep { -e $_->tempname }
	279	ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
c85ff642	280	}
c85ff642	281	}
fc7ec1d9	282	}
fc7ec1d9	283
fbcc39ad	284	=item $self->prepare_body($c)
fc7ec1d9	285
	286	=cut
	287
fbcc39ad	288	sub prepare_body {
fbcc39ad	289	my ( $self, $c ) = @_;
99fe1710	290
fbcc39ad	291	$self->read_length( $c->request->header('Content-Length') \|\| 0 );
fbcc39ad	292	my $type = $c->request->header('Content-Type');
99fe1710	293
fbcc39ad	294	unless ( $c->request->{_body} ) {
fbcc39ad	295	$c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
fc7ec1d9	296	}
4f5ebacd	297
fbcc39ad	298	if ( $self->read_length > 0 ) {
4f5ebacd	299	while ( my $buffer = $self->read($c) ) {
4f5ebacd	300	$c->prepare_body_chunk($buffer);
fbcc39ad	301	}
fc7ec1d9	302	}
	303	}
	304
4bd82c41	305	=item $self->prepare_body_chunk($c)
	306
	307	=cut
	308
	309	sub prepare_body_chunk {
	310	my ( $self, $c, $chunk ) = @_;
4f5ebacd	311
4f5ebacd	312	$c->request->{_body}->add($chunk);
4bd82c41	313	}
4bd82c41	314
fbcc39ad	315	=item $self->prepare_body_parameters($c)
06e1b616	316
	317	=cut
	318
fbcc39ad	319	sub prepare_body_parameters {
	320	my ( $self, $c ) = @_;
	321	$c->request->body_parameters( $c->request->{_body}->param );
	322	}
0556eb49	323
fbcc39ad	324	=item $self->prepare_connection($c)
0556eb49	325
	326	=cut
	327
	328	sub prepare_connection { }
	329
fbcc39ad	330	=item $self->prepare_cookies($c)
fc7ec1d9	331
	332	=cut
	333
6dc87a0f	334	sub prepare_cookies {
fbcc39ad	335	my ( $self, $c ) = @_;
6dc87a0f	336
	337	if ( my $header = $c->request->header('Cookie') ) {
	338	$c->req->cookies( { CGI::Cookie->parse($header) } );
	339	}
	340	}
fc7ec1d9	341
fbcc39ad	342	=item $self->prepare_headers($c)
fc7ec1d9	343
	344	=cut
	345
	346	sub prepare_headers { }
	347
fbcc39ad	348	=item $self->prepare_parameters($c)
fc7ec1d9	349
	350	=cut
	351
fbcc39ad	352	sub prepare_parameters {
fbcc39ad	353	my ( $self, $c ) = @_;
fc7ec1d9	354
fbcc39ad	355	# We copy, no references
	356	while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
	357	$param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
	358	$c->request->parameters->{$name} = $param;
	359	}
fc7ec1d9	360
fbcc39ad	361	# Merge query and body parameters
	362	while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
	363	$param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
	364	if ( my $old_param = $c->request->parameters->{$name} ) {
	365	if ( ref $old_param eq 'ARRAY' ) {
	366	push @{ $c->request->parameters->{$name} },
	367	ref $param eq 'ARRAY' ? @$param : $param;
	368	}
	369	else { $c->request->parameters->{$name} = [ $old_param, $param ] }
	370	}
	371	else { $c->request->parameters->{$name} = $param }
	372	}
	373	}
	374
	375	=item $self->prepare_path($c)
fc7ec1d9	376
	377	=cut
	378
	379	sub prepare_path { }
	380
fbcc39ad	381	=item $self->prepare_request($c)
fc7ec1d9	382
fbcc39ad	383	=item $self->prepare_query_parameters($c)
fc7ec1d9	384
	385	=cut
	386
e0616220	387	sub prepare_query_parameters {
	388	my ( $self, $c, $query_string ) = @_;
	389
	390	# replace semi-colons
	391	$query_string =~ s/;/&/g;
	392
	393	my $u = URI->new( '', 'http' );
f4a57de4	394	$u->query($query_string);
	395	for my $key ( $u->query_param ) {
	396	my @vals = $u->query_param($key);
	397	$c->request->query_parameters->{$key} = @vals > 1 ? [@vals] : $vals[0];
e0616220	398	}
e0616220	399	}
fbcc39ad	400
	401	=item $self->prepare_read($c)
	402
	403	=cut
fc7ec1d9	404
fbcc39ad	405	sub prepare_read {
fbcc39ad	406	my ( $self, $c ) = @_;
4f5ebacd	407
fbcc39ad	408	# Reset the read position
4f5ebacd	409	$self->read_position(0);
fbcc39ad	410	}
fc7ec1d9	411
fbcc39ad	412	=item $self->prepare_request(@arguments)
fc7ec1d9	413
	414	=cut
	415
fbcc39ad	416	sub prepare_request { }
fc7ec1d9	417
fbcc39ad	418	=item $self->prepare_uploads($c)
c9afa5fc	419
fbcc39ad	420	=cut
	421
	422	sub prepare_uploads {
	423	my ( $self, $c ) = @_;
	424	my $uploads = $c->request->{_body}->upload;
	425	for my $name ( keys %$uploads ) {
	426	my $files = $uploads->{$name};
	427	$files = ref $files eq 'ARRAY' ? $files : [$files];
	428	my @uploads;
	429	for my $upload (@$files) {
	430	my $u = Catalyst::Request::Upload->new;
	431	$u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
	432	$u->type( $u->headers->content_type );
	433	$u->tempname( $upload->{tempname} );
	434	$u->size( $upload->{size} );
	435	$u->filename( $upload->{filename} );
	436	push @uploads, $u;
	437	}
	438	$c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
f4a57de4	439
c4bed79a	440	# support access to the filename as a normal param
c4bed79a	441	my @filenames = map { $_->{filename} } @uploads;
f4a57de4	442	$c->request->parameters->{$name} =
f4a57de4	443	@filenames > 1 ? \@filenames : $filenames[0];
fbcc39ad	444	}
	445	}
	446
	447	=item $self->prepare_write($c)
c9afa5fc	448
	449	=cut
	450
fbcc39ad	451	sub prepare_write { }
	452
	453	=item $self->read($c, [$maxlength])
	454
	455	=cut
	456
	457	sub read {
	458	my ( $self, $c, $maxlength ) = @_;
4f5ebacd	459
fbcc39ad	460	unless ( $self->{_prepared_read} ) {
4f5ebacd	461	$self->prepare_read($c);
fbcc39ad	462	$self->{_prepared_read} = 1;
fbcc39ad	463	}
4f5ebacd	464
fbcc39ad	465	my $remaining = $self->read_length - $self->read_position;
4bd82c41	466	$maxlength \|\|= $CHUNKSIZE;
4f5ebacd	467
fbcc39ad	468	# Are we done reading?
fbcc39ad	469	if ( $remaining <= 0 ) {
4f5ebacd	470	$self->finalize_read($c);
fbcc39ad	471	return;
fbcc39ad	472	}
c9afa5fc	473
fbcc39ad	474	my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
	475	my $rc = $self->read_chunk( $c, my $buffer, $readlen );
	476	if ( defined $rc ) {
	477	$self->read_position( $self->read_position + $rc );
	478	return $buffer;
	479	}
	480	else {
4f5ebacd	481	Catalyst::Exception->throw(
4f5ebacd	482	message => "Unknown error reading input: $!" );
fbcc39ad	483	}
fbcc39ad	484	}
fc7ec1d9	485
fbcc39ad	486	=item $self->read_chunk($c, $buffer, $length)
23f9d934	487
fbcc39ad	488	Each engine inplements read_chunk as its preferred way of reading a chunk
fbcc39ad	489	of data.
fc7ec1d9	490
fbcc39ad	491	=cut
61b1e958	492
fbcc39ad	493	sub read_chunk { }
61b1e958	494
fbcc39ad	495	=item $self->read_length
ca39d576	496
fbcc39ad	497	The length of input data to be read. This is obtained from the Content-Length
fbcc39ad	498	header.
fc7ec1d9	499
fbcc39ad	500	=item $self->read_position
fc7ec1d9	501
fbcc39ad	502	The amount of input data that has already been read.
63b763c5	503
fbcc39ad	504	=item $self->run($c)
63b763c5	505
fbcc39ad	506	=cut
fc7ec1d9	507
fbcc39ad	508	sub run { }
fc7ec1d9	509
fbcc39ad	510	=item $self->write($c, $buffer)
fc7ec1d9	511
	512	=cut
	513
fbcc39ad	514	sub write {
fbcc39ad	515	my ( $self, $c, $buffer ) = @_;
4f5ebacd	516
fbcc39ad	517	unless ( $self->{_prepared_write} ) {
4f5ebacd	518	$self->prepare_write($c);
fbcc39ad	519	$self->{_prepared_write} = 1;
fc7ec1d9	520	}
4f5ebacd	521
4f5ebacd	522	print STDOUT $buffer;
fc7ec1d9	523	}
fc7ec1d9	524
23f9d934	525	=back
23f9d934	526
fbcc39ad	527	=head1 AUTHORS
	528
	529	Sebastian Riedel, <sri@cpan.org>
fc7ec1d9	530
fbcc39ad	531	Andy Grundman, <andy@hybridized.org>
fc7ec1d9	532
	533	=head1 COPYRIGHT
	534
	535	This program is free software, you can redistribute it and/or modify it under
	536	the same terms as Perl itself.
	537
	538	=cut
	539
	540	1;