[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 ) = @_;

    $self->write( $c, $c->response->output );
}

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