[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 );
            $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->headers->content_type('text/html');
    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 { '<code class="error">' . encode_entities($_) . '</code>' }
          @{ $c->error };
        $error ||= 'No output';
        $title = $name = "$name on Catalyst $Catalyst::VERSION";

        # 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;
        $infos = <<"";
<br/>
<b><u>Request</u></b><br/>
<pre>$req</pre>
<b><u>Response</u></b><br/>
<pre>$res</pre>
<b><u>Stash</u></b><br/>
<pre>$stash</pre>

    }
    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( <<"" );
<html>
<head>
    <title>$title</title>
    <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;
        }
        div.box {
            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;
        }
    </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 );
f4a57de4	50	$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
	93	$c->res->headers->content_type('text/html');
	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 '',
	102	map { '<code class="error">' . encode_entities($_) . '</code>' }
	103	@{ $c->error };
969647fd	104	$error \|\|= 'No output';
969647fd	105	$title = $name = "$name on Catalyst $Catalyst::VERSION";
fbcc39ad	106
	107	# Don't show context in the dump
	108	delete $c->req->{_context};
	109	delete $c->res->{_context};
	110
	111	# Don't show body parser in the dump
	112	delete $c->req->{_body};
	113
	114	# Don't show response header state in dump
	115	delete $c->res->{_finalized_headers};
	116
969647fd	117	my $req = encode_entities Dumper $c->req;
	118	my $res = encode_entities Dumper $c->res;
	119	my $stash = encode_entities Dumper $c->stash;
	120	$infos = <<"";
	121	<br/>
	122	<b><u>Request</u></b><br/>
	123	<pre>$req</pre>
	124	<b><u>Response</u></b><br/>
	125	<pre>$res</pre>
	126	<b><u>Stash</u></b><br/>
	127	<pre>$stash</pre>
	128
	129	}
	130	else {
	131	$title = $name;
	132	$error = '';
	133	$infos = <<"";
	134	<pre>
	135	(en) Please come back later
	136	(de) Bitte versuchen sie es spaeter nocheinmal
	137	(nl) Gelieve te komen later terug
	138	(no) Vennligst prov igjen senere
	139	(fr) Veuillez revenir plus tard
	140	(es) Vuelto por favor mas adelante
	141	(pt) Voltado por favor mais tarde
fbcc39ad	142	(it) Ritornato prego più successivamente
969647fd	143	</pre>
	144
	145	$name = '';
	146	}
e060fe05	147	$c->res->body( <<"" );
969647fd	148	<html>
	149	<head>
	150	<title>$title</title>
	151	<style type="text/css">
	152	body {
	153	font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
	154	Tahoma, Arial, helvetica, sans-serif;
	155	color: #ddd;
	156	background-color: #eee;
	157	margin: 0px;
	158	padding: 0px;
	159	}
	160	div.box {
	161	background-color: #ccc;
	162	border: 1px solid #aaa;
	163	padding: 4px;
	164	margin: 10px;
	165	-moz-border-radius: 10px;
	166	}
	167	div.error {
	168	background-color: #977;
	169	border: 1px solid #755;
	170	padding: 8px;
	171	margin: 4px;
	172	margin-bottom: 10px;
	173	-moz-border-radius: 10px;
	174	}
	175	div.infos {
	176	background-color: #797;
	177	border: 1px solid #575;
	178	padding: 8px;
	179	margin: 4px;
	180	margin-bottom: 10px;
	181	-moz-border-radius: 10px;
	182	}
	183	div.name {
	184	background-color: #779;
	185	border: 1px solid #557;
	186	padding: 8px;
	187	margin: 4px;
	188	-moz-border-radius: 10px;
	189	}
7f8e0078	190	code.error {
	191	display: block;
	192	margin: 1em 0;
	193	overflow: auto;
	194	white-space: pre;
	195	}
969647fd	196	</style>
	197	</head>
	198	<body>
	199	<div class="box">
	200	<div class="error">$error</div>
	201	<div class="infos">$infos</div>
	202	<div class="name">$name</div>
	203	</div>
	204	</body>
	205	</html>
	206
	207	}
	208
fbcc39ad	209	=item $self->finalize_headers($c)
fc7ec1d9	210
	211	=cut
	212
	213	sub finalize_headers { }
	214
fbcc39ad	215	=item $self->finalize_read($c)
fc7ec1d9	216
	217	=cut
	218
fbcc39ad	219	sub finalize_read {
fbcc39ad	220	my ( $self, $c ) = @_;
4f5ebacd	221
fbcc39ad	222	undef $self->{_prepared_read};
fc7ec1d9	223	}
fc7ec1d9	224
fbcc39ad	225	=item $self->finalize_uploads($c)
fc7ec1d9	226
	227	=cut
	228
fbcc39ad	229	sub finalize_uploads {
fbcc39ad	230	my ( $self, $c ) = @_;
99fe1710	231
fbcc39ad	232	if ( keys %{ $c->request->uploads } ) {
	233	for my $key ( keys %{ $c->request->uploads } ) {
	234	my $upload = $c->request->uploads->{$key};
	235	unlink map { $_->tempname }
	236	grep { -e $_->tempname }
	237	ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
c85ff642	238	}
c85ff642	239	}
fc7ec1d9	240	}
fc7ec1d9	241
fbcc39ad	242	=item $self->prepare_body($c)
fc7ec1d9	243
	244	=cut
	245
fbcc39ad	246	sub prepare_body {
fbcc39ad	247	my ( $self, $c ) = @_;
99fe1710	248
fbcc39ad	249	$self->read_length( $c->request->header('Content-Length') \|\| 0 );
fbcc39ad	250	my $type = $c->request->header('Content-Type');
99fe1710	251
fbcc39ad	252	unless ( $c->request->{_body} ) {
fbcc39ad	253	$c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
fc7ec1d9	254	}
4f5ebacd	255
fbcc39ad	256	if ( $self->read_length > 0 ) {
4f5ebacd	257	while ( my $buffer = $self->read($c) ) {
4f5ebacd	258	$c->prepare_body_chunk($buffer);
fbcc39ad	259	}
fc7ec1d9	260	}
	261	}
	262
4bd82c41	263	=item $self->prepare_body_chunk($c)
	264
	265	=cut
	266
	267	sub prepare_body_chunk {
	268	my ( $self, $c, $chunk ) = @_;
4f5ebacd	269
4f5ebacd	270	$c->request->{_body}->add($chunk);
4bd82c41	271	}
4bd82c41	272
fbcc39ad	273	=item $self->prepare_body_parameters($c)
06e1b616	274
	275	=cut
	276
fbcc39ad	277	sub prepare_body_parameters {
	278	my ( $self, $c ) = @_;
	279	$c->request->body_parameters( $c->request->{_body}->param );
	280	}
0556eb49	281
fbcc39ad	282	=item $self->prepare_connection($c)
0556eb49	283
	284	=cut
	285
	286	sub prepare_connection { }
	287
fbcc39ad	288	=item $self->prepare_cookies($c)
fc7ec1d9	289
	290	=cut
	291
6dc87a0f	292	sub prepare_cookies {
fbcc39ad	293	my ( $self, $c ) = @_;
6dc87a0f	294
	295	if ( my $header = $c->request->header('Cookie') ) {
	296	$c->req->cookies( { CGI::Cookie->parse($header) } );
	297	}
	298	}
fc7ec1d9	299
fbcc39ad	300	=item $self->prepare_headers($c)
fc7ec1d9	301
	302	=cut
	303
	304	sub prepare_headers { }
	305
fbcc39ad	306	=item $self->prepare_parameters($c)
fc7ec1d9	307
	308	=cut
	309
fbcc39ad	310	sub prepare_parameters {
fbcc39ad	311	my ( $self, $c ) = @_;
fc7ec1d9	312
fbcc39ad	313	# We copy, no references
	314	while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
	315	$param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
	316	$c->request->parameters->{$name} = $param;
	317	}
fc7ec1d9	318
fbcc39ad	319	# Merge query and body parameters
	320	while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
	321	$param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
	322	if ( my $old_param = $c->request->parameters->{$name} ) {
	323	if ( ref $old_param eq 'ARRAY' ) {
	324	push @{ $c->request->parameters->{$name} },
	325	ref $param eq 'ARRAY' ? @$param : $param;
	326	}
	327	else { $c->request->parameters->{$name} = [ $old_param, $param ] }
	328	}
	329	else { $c->request->parameters->{$name} = $param }
	330	}
	331	}
	332
	333	=item $self->prepare_path($c)
fc7ec1d9	334
	335	=cut
	336
	337	sub prepare_path { }
	338
fbcc39ad	339	=item $self->prepare_request($c)
fc7ec1d9	340
fbcc39ad	341	=item $self->prepare_query_parameters($c)
fc7ec1d9	342
	343	=cut
	344
e0616220	345	sub prepare_query_parameters {
	346	my ( $self, $c, $query_string ) = @_;
	347
	348	# replace semi-colons
	349	$query_string =~ s/;/&/g;
	350
	351	my $u = URI->new( '', 'http' );
f4a57de4	352	$u->query($query_string);
	353	for my $key ( $u->query_param ) {
	354	my @vals = $u->query_param($key);
	355	$c->request->query_parameters->{$key} = @vals > 1 ? [@vals] : $vals[0];
e0616220	356	}
e0616220	357	}
fbcc39ad	358
	359	=item $self->prepare_read($c)
	360
	361	=cut
fc7ec1d9	362
fbcc39ad	363	sub prepare_read {
fbcc39ad	364	my ( $self, $c ) = @_;
4f5ebacd	365
fbcc39ad	366	# Reset the read position
4f5ebacd	367	$self->read_position(0);
fbcc39ad	368	}
fc7ec1d9	369
fbcc39ad	370	=item $self->prepare_request(@arguments)
fc7ec1d9	371
	372	=cut
	373
fbcc39ad	374	sub prepare_request { }
fc7ec1d9	375
fbcc39ad	376	=item $self->prepare_uploads($c)
c9afa5fc	377
fbcc39ad	378	=cut
	379
	380	sub prepare_uploads {
	381	my ( $self, $c ) = @_;
	382	my $uploads = $c->request->{_body}->upload;
	383	for my $name ( keys %$uploads ) {
	384	my $files = $uploads->{$name};
	385	$files = ref $files eq 'ARRAY' ? $files : [$files];
	386	my @uploads;
	387	for my $upload (@$files) {
	388	my $u = Catalyst::Request::Upload->new;
	389	$u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
	390	$u->type( $u->headers->content_type );
	391	$u->tempname( $upload->{tempname} );
	392	$u->size( $upload->{size} );
	393	$u->filename( $upload->{filename} );
	394	push @uploads, $u;
	395	}
	396	$c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
f4a57de4	397
c4bed79a	398	# support access to the filename as a normal param
c4bed79a	399	my @filenames = map { $_->{filename} } @uploads;
f4a57de4	400	$c->request->parameters->{$name} =
f4a57de4	401	@filenames > 1 ? \@filenames : $filenames[0];
fbcc39ad	402	}
	403	}
	404
	405	=item $self->prepare_write($c)
c9afa5fc	406
	407	=cut
	408
fbcc39ad	409	sub prepare_write { }
	410
	411	=item $self->read($c, [$maxlength])
	412
	413	=cut
	414
	415	sub read {
	416	my ( $self, $c, $maxlength ) = @_;
4f5ebacd	417
fbcc39ad	418	unless ( $self->{_prepared_read} ) {
4f5ebacd	419	$self->prepare_read($c);
fbcc39ad	420	$self->{_prepared_read} = 1;
fbcc39ad	421	}
4f5ebacd	422
fbcc39ad	423	my $remaining = $self->read_length - $self->read_position;
4bd82c41	424	$maxlength \|\|= $CHUNKSIZE;
4f5ebacd	425
fbcc39ad	426	# Are we done reading?
fbcc39ad	427	if ( $remaining <= 0 ) {
4f5ebacd	428	$self->finalize_read($c);
fbcc39ad	429	return;
fbcc39ad	430	}
c9afa5fc	431
fbcc39ad	432	my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
	433	my $rc = $self->read_chunk( $c, my $buffer, $readlen );
	434	if ( defined $rc ) {
	435	$self->read_position( $self->read_position + $rc );
	436	return $buffer;
	437	}
	438	else {
4f5ebacd	439	Catalyst::Exception->throw(
4f5ebacd	440	message => "Unknown error reading input: $!" );
fbcc39ad	441	}
fbcc39ad	442	}
fc7ec1d9	443
fbcc39ad	444	=item $self->read_chunk($c, $buffer, $length)
23f9d934	445
fbcc39ad	446	Each engine inplements read_chunk as its preferred way of reading a chunk
fbcc39ad	447	of data.
fc7ec1d9	448
fbcc39ad	449	=cut
61b1e958	450
fbcc39ad	451	sub read_chunk { }
61b1e958	452
fbcc39ad	453	=item $self->read_length
ca39d576	454
fbcc39ad	455	The length of input data to be read. This is obtained from the Content-Length
fbcc39ad	456	header.
fc7ec1d9	457
fbcc39ad	458	=item $self->read_position
fc7ec1d9	459
fbcc39ad	460	The amount of input data that has already been read.
63b763c5	461
fbcc39ad	462	=item $self->run($c)
63b763c5	463
fbcc39ad	464	=cut
fc7ec1d9	465
fbcc39ad	466	sub run { }
fc7ec1d9	467
fbcc39ad	468	=item $self->write($c, $buffer)
fc7ec1d9	469
	470	=cut
	471
fbcc39ad	472	sub write {
fbcc39ad	473	my ( $self, $c, $buffer ) = @_;
4f5ebacd	474
fbcc39ad	475	unless ( $self->{_prepared_write} ) {
4f5ebacd	476	$self->prepare_write($c);
fbcc39ad	477	$self->{_prepared_write} = 1;
fc7ec1d9	478	}
4f5ebacd	479
4f5ebacd	480	print STDOUT $buffer;
fc7ec1d9	481	}
fc7ec1d9	482
23f9d934	483	=back
23f9d934	484
fbcc39ad	485	=head1 AUTHORS
	486
	487	Sebastian Riedel, <sri@cpan.org>
fc7ec1d9	488
fbcc39ad	489	Andy Grundman, <andy@hybridized.org>
fc7ec1d9	490
	491	=head1 COPYRIGHT
	492
	493	This program is free software, you can redistribute it and/or modify it under
	494	the same terms as Perl itself.
	495
	496	=cut
	497
	498	1;