[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

=head2 $self->finalize_output

<obsolete>, see finalize_body

=head2 $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 );
    }
}

=head2 $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;
    }

    for my $cookie (@cookies) {
        $c->res->headers->push_header( 'Set-Cookie' => $cookie );
    }
}

=head2 $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';
        $error = "<pre>$error</pre>";
        $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;
        }
        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>

}

=head2 $self->finalize_headers($c)

=cut

sub finalize_headers { }

=head2 $self->finalize_read($c)

=cut

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

    undef $self->{_prepared_read};
}

=head2 $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);
        }
    }
}

=head2 $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);
        }
    }
}

=head2 $self->prepare_body_chunk($c)

=cut

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

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

=head2 $self->prepare_body_parameters($c)

=cut

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

=head2 $self->prepare_connection($c)

=cut

sub prepare_connection { }

=head2 $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) } );
    }
}

=head2 $self->prepare_headers($c)

=cut

sub prepare_headers { }

=head2 $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 }
    }
}

=head2 $self->prepare_path($c)

=cut

sub prepare_path { }

=head2 $self->prepare_request($c)

=head2 $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];
    }
}

=head2 $self->prepare_read($c)

=cut

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

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

=head2 $self->prepare_request(@arguments)

=cut

sub prepare_request { }

=head2 $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];
    }
}

=head2 $self->prepare_write($c)

=cut

sub prepare_write { }

=head2 $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: $!" );
    }
}

=head2 $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 { }

=head2 $self->read_length

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

=head2 $self->read_position

The amount of input data that has already been read.

=head2 $self->run($c)

=cut

sub run { }

=head2 $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;
}

=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
b5ecfcf0	33	=head2 $self->finalize_output
cd3bb248	34
	35	<obsolete>, see finalize_body
	36
b5ecfcf0	37	=head2 $self->finalize_body($c)
06e1b616	38
fbcc39ad	39	Finalize body. Prints the response output.
06e1b616	40
	41	=cut
	42
fbcc39ad	43	sub finalize_body {
fbcc39ad	44	my ( $self, $c ) = @_;
f4a57de4	45	if ( ref $c->response->body && $c->response->body->can('read') ) {
f4a57de4	46	while ( !$c->response->body->eof() ) {
6e692ab4	47	$c->response->body->read( my $buffer, $CHUNKSIZE );
6484fba0	48	last unless $self->write( $c, $buffer );
f4a57de4	49	}
6e692ab4	50	$c->response->body->close();
f4a57de4	51	}
f4a57de4	52	else {
6e692ab4	53	$self->write( $c, $c->response->body );
f4a57de4	54	}
fbcc39ad	55	}
6dc87a0f	56
b5ecfcf0	57	=head2 $self->finalize_cookies($c)
6dc87a0f	58
	59	=cut
	60
	61	sub finalize_cookies {
fbcc39ad	62	my ( $self, $c ) = @_;
6dc87a0f	63
fbcc39ad	64	my @cookies;
6dc87a0f	65	while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
fbcc39ad	66
6dc87a0f	67	my $cookie = CGI::Cookie->new(
	68	-name => $name,
	69	-value => $cookie->{value},
	70	-expires => $cookie->{expires},
	71	-domain => $cookie->{domain},
	72	-path => $cookie->{path},
	73	-secure => $cookie->{secure} \|\| 0
	74	);
	75
fbcc39ad	76	push @cookies, $cookie->as_string;
6dc87a0f	77	}
6dc87a0f	78
b39840da	79	for my $cookie (@cookies) {
b39840da	80	$c->res->headers->push_header( 'Set-Cookie' => $cookie );
fbcc39ad	81	}
fbcc39ad	82	}
969647fd	83
b5ecfcf0	84	=head2 $self->finalize_error($c)
969647fd	85
	86	=cut
	87
	88	sub finalize_error {
fbcc39ad	89	my ( $self, $c ) = @_;
969647fd	90
7299a7b4	91	$c->res->content_type('text/html; charset=utf-8');
969647fd	92	my $name = $c->config->{name} \|\| 'Catalyst Application';
	93
	94	my ( $title, $error, $infos );
	95	if ( $c->debug ) {
62d9b030	96
	97	# For pretty dumps
	98	local $Data::Dumper::Terse = 1;
b5ecfcf0	99	$error = join '', map {
	100	'<p><code class="error">'
	101	. encode_entities($_)
	102	. '</code></p>'
	103	} @{ $c->error };
969647fd	104	$error \|\|= 'No output';
f0038735	105	$error = "<pre>$error</pre>";
969647fd	106	$title = $name = "$name on Catalyst $Catalyst::VERSION";
9619f23c	107	$name = "<h1>$name</h1>";
fbcc39ad	108
	109	# Don't show context in the dump
	110	delete $c->req->{_context};
	111	delete $c->res->{_context};
	112
	113	# Don't show body parser in the dump
	114	delete $c->req->{_body};
	115
	116	# Don't show response header state in dump
	117	delete $c->res->{_finalized_headers};
	118
969647fd	119	my $req = encode_entities Dumper $c->req;
	120	my $res = encode_entities Dumper $c->res;
	121	my $stash = encode_entities Dumper $c->stash;
969647fd	122
c6ef5e69	123	my @infos;
c6ef5e69	124	my $i = 0;
c6ef5e69	125	for my $dump ( $c->dump_these ) {
c6ef5e69	126	my $name = $dump->[0];
	127	my $value = encode_entities( Dumper $dump->[1] );
	128	push @infos, sprintf <<"EOF", $name, $value;
9619f23c	129	<h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
c6ef5e69	130	<div id="dump_$i">
	131	<pre>%s</pre>
	132	</div>
	133	EOF
	134	$i++;
	135	}
	136	$infos = join "\n", @infos;
969647fd	137	}
	138	else {
	139	$title = $name;
	140	$error = '';
	141	$infos = <<"";
	142	<pre>
	143	(en) Please come back later
	144	(de) Bitte versuchen sie es spaeter nocheinmal
	145	(nl) Gelieve te komen later terug
	146	(no) Vennligst prov igjen senere
	147	(fr) Veuillez revenir plus tard
	148	(es) Vuelto por favor mas adelante
	149	(pt) Voltado por favor mais tarde
fbcc39ad	150	(it) Ritornato prego più successivamente
969647fd	151	</pre>
	152
	153	$name = '';
	154	}
e060fe05	155	$c->res->body( <<"" );
7299a7b4	156	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
	157	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
	158	<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
969647fd	159	<head>
7299a7b4	160	<meta http-equiv="Content-Language" content="en" />
7299a7b4	161	<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
969647fd	162	<title>$title</title>
7299a7b4	163	<script type="text/javascript">
c6ef5e69	164	<!--
c6ef5e69	165	function toggleDump (dumpElement) {
7299a7b4	166	var e = document.getElementById( dumpElement );
	167	if (e.style.display == "none") {
	168	e.style.display = "";
c6ef5e69	169	}
c6ef5e69	170	else {
7299a7b4	171	e.style.display = "none";
c6ef5e69	172	}
	173	}
	174	-->
	175	</script>
969647fd	176	<style type="text/css">
	177	body {
	178	font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
	179	Tahoma, Arial, helvetica, sans-serif;
	180	color: #ddd;
	181	background-color: #eee;
	182	margin: 0px;
	183	padding: 0px;
	184	}
c6ef5e69	185	:link, :link:hover, :visited, :visited:hover {
	186	color: #ddd;
	187	}
969647fd	188	div.box {
9619f23c	189	position: relative;
969647fd	190	background-color: #ccc;
	191	border: 1px solid #aaa;
	192	padding: 4px;
	193	margin: 10px;
	194	-moz-border-radius: 10px;
	195	}
	196	div.error {
	197	background-color: #977;
	198	border: 1px solid #755;
	199	padding: 8px;
	200	margin: 4px;
	201	margin-bottom: 10px;
	202	-moz-border-radius: 10px;
	203	}
	204	div.infos {
	205	background-color: #797;
	206	border: 1px solid #575;
	207	padding: 8px;
	208	margin: 4px;
	209	margin-bottom: 10px;
	210	-moz-border-radius: 10px;
	211	}
	212	div.name {
	213	background-color: #779;
	214	border: 1px solid #557;
	215	padding: 8px;
	216	margin: 4px;
	217	-moz-border-radius: 10px;
	218	}
7f8e0078	219	code.error {
	220	display: block;
	221	margin: 1em 0;
	222	overflow: auto;
7f8e0078	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
b5ecfcf0	251	=head2 $self->finalize_headers($c)
fc7ec1d9	252
	253	=cut
	254
	255	sub finalize_headers { }
	256
b5ecfcf0	257	=head2 $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
b5ecfcf0	267	=head2 $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
b5ecfcf0	284	=head2 $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
b5ecfcf0	305	=head2 $self->prepare_body_chunk($c)
4bd82c41	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
b5ecfcf0	315	=head2 $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
b5ecfcf0	324	=head2 $self->prepare_connection($c)
0556eb49	325
	326	=cut
	327
	328	sub prepare_connection { }
	329
b5ecfcf0	330	=head2 $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
b5ecfcf0	342	=head2 $self->prepare_headers($c)
fc7ec1d9	343
	344	=cut
	345
	346	sub prepare_headers { }
	347
b5ecfcf0	348	=head2 $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
b5ecfcf0	375	=head2 $self->prepare_path($c)
fc7ec1d9	376
	377	=cut
	378
	379	sub prepare_path { }
	380
b5ecfcf0	381	=head2 $self->prepare_request($c)
fc7ec1d9	382
b5ecfcf0	383	=head2 $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
b5ecfcf0	401	=head2 $self->prepare_read($c)
fbcc39ad	402
fbcc39ad	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
b5ecfcf0	412	=head2 $self->prepare_request(@arguments)
fc7ec1d9	413
	414	=cut
	415
fbcc39ad	416	sub prepare_request { }
fc7ec1d9	417
b5ecfcf0	418	=head2 $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
b5ecfcf0	447	=head2 $self->prepare_write($c)
c9afa5fc	448
	449	=cut
	450
fbcc39ad	451	sub prepare_write { }
fbcc39ad	452
b5ecfcf0	453	=head2 $self->read($c, [$maxlength])
fbcc39ad	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
b5ecfcf0	486	=head2 $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
b5ecfcf0	495	=head2 $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
b5ecfcf0	500	=head2 $self->read_position
fc7ec1d9	501
fbcc39ad	502	The amount of input data that has already been read.
63b763c5	503
b5ecfcf0	504	=head2 $self->run($c)
63b763c5	505
fbcc39ad	506	=cut
fc7ec1d9	507
fbcc39ad	508	sub run { }
fc7ec1d9	509
b5ecfcf0	510	=head2 $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
fbcc39ad	525	=head1 AUTHORS
	526
	527	Sebastian Riedel, <sri@cpan.org>
fc7ec1d9	528
fbcc39ad	529	Andy Grundman, <andy@hybridized.org>
fc7ec1d9	530
	531	=head1 COPYRIGHT
	532
	533	This program is free software, you can redistribute it and/or modify it under
	534	the same terms as Perl itself.
	535
	536	=cut
	537
	538	1;