# This file documents the revision history for Perl extension Catalyst.
+ - Add a clearer method on request and response _context
+ attributes, and use if from ::Engine rather than deleting
+ the key from the instance hash (t0m)
+ - Use handles on tree attribute of Catalyst::Stats to replace
+ trivial delegation methods (t0m)
+ - Change the following direct hash accesses into attributes:
+ Catalyst::Engine: _prepared_write
+ Catalyst::Engine::CGI: _header_buf
+ Catalyst::Engine::HTTP: options, _keepalive, _write_error
+ Catalyst::Request: _path
+ Catalyst::Request::Upload: basename
+ Catalyst::Stats: tree
+ (t0m)
- Fix issues in Catalyst::Controller::WrapCGI
and any other components which import (or define) their
own meta method by always explicitly calling
- Fix t/caf_backcompat_plugin_accessor_override.t
- meta-method.diff test for MX::Emulate::CAF needed by
- ::Plugin::Cache::Curried
+ Catalyst::Plugin::Cache::Curried
- Common engine test failures, look into and get tests into core.
- After that set up attr handlers that will output helpful error messages
when you do it as well as how to fix it. (done already?)
- - Comments marked /Moose TODO/i in the code
+ - Comments marked /Moose TODO/i in Catalyst::Request re {_body}
- - Eliminate all instances of $instance->{$key}
+ - Eliminate all instances of $instance->{$key}, I think the only thing
+ left is lib/Catalyst/Engine/HTTP.pm: $self->{inputbuf}, which I haven't
+ touched as it is used as an lvalue in a lot of places.
- - Catalyst-Log-Log4perl - deep recursion in the test suite, investigate
+ - Catalyst-Log-Log4perl - deep recursion in the test suite, investigate.
- Profiling vs 5.70 and optimisation as needed.
- http://lists.scsys.co.uk/pipermail/catalyst-dev/2008-November/001546.html
- patch to list, andyg to look at?
+ - Fix the Roadmap to be less full of lies.
+
+ - Run another round of repository smokes against latest 5.80 trunk, manually
+ go through all the things which are broken.
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
$response->header( Location => $location );
- #Moose TODO: we should probably be using a predicate method here ?
- if ( !$response->body ) {
+ if ( !$response->has_body ) {
# Add a default body if none is already present
$response->body(
qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
has read_length => (is => 'rw');
has read_position => (is => 'rw');
+has _prepared_write => (is => 'rw');
+
no Moose;
# Amount of data to read from input on each pass
$name = "<h1>$name</h1>";
# Don't show context in the dump
- delete $c->req->{_context};
- delete $c->res->{_context};
+ $c->req->_clear_context;
+ $c->res->_clear_context;
# Don't show body parser in the dump
delete $c->req->{_body};
sub write {
my ( $self, $c, $buffer ) = @_;
- unless ( $self->{_prepared_write} ) {
+ unless ( $self->_prepared_write ) {
$self->prepare_write($c);
- $self->{_prepared_write} = 1;
+ $self->_prepared_write(1);
}
return 0 if !defined $buffer;
extends 'Catalyst::Engine';
has env => (is => 'rw');
+has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf');
=head1 NAME
$c->response->header( Status => $c->response->status );
- $self->{_header_buf}
- = $c->response->headers->as_string("\015\012") . "\015\012";
+ $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012");
}
=head2 $self->prepare_connection($c)
my ( $self, $c, $buffer ) = @_;
# Prepend the headers if they have not yet been sent
- if ( my $headers = delete $self->{_header_buf} ) {
- $buffer = $headers . $buffer;
+ if ( $self->_has_header_buf ) {
+ $buffer = $self->_clear_header_buf . $buffer;
}
return $self->$orig( $c, $buffer );
sub write {
my ( $self, $c, $buffer ) = @_;
- unless ( $self->{_prepared_write} ) {
+ unless ( $self->_prepared_write ) {
$self->prepare_write($c);
- $self->{_prepared_write} = 1;
+ $self->_prepared_write(1);
}
# XXX: We can't use Engine's write() method because syswrite
# written: http://www.fastcgi.com/om_archive/mail-archive/0128.html
# Prepend the headers if they have not yet been sent
- if ( my $headers = delete $self->{_header_buf} ) {
- $buffer = $headers . $buffer;
+ if ( $self->_has_header_buf ) {
+ $buffer = $self->_clear_header_buf . $buffer;
}
# FastCGI does not stream data properly if using 'print $handle',
use constant CHUNKSIZE => 64 * 1024;
use constant DEBUG => $ENV{CATALYST_HTTP_DEBUG} || 0;
+has options => ( is => 'rw' );
+has _keepalive => ( is => 'rw', predicate => '_is_keepalive', clearer => '_clear_keepalive' );
+has _write_error => ( is => 'rw', predicate => '_has_write_error' );
+
use namespace::clean -except => [qw/meta/];
=head1 NAME
# Should we keep the connection open?
my $connection = $c->request->header('Connection');
- if ( $self->{options}->{keepalive}
+ if ( $self->options->{keepalive}
&& $connection
&& $connection =~ /^keep-alive$/i
) {
$res_headers->header( Connection => 'keep-alive' );
- $self->{_keepalive} = 1;
+ $self->_keepalive(1);
}
else {
$res_headers->header( Connection => 'close' );
# Buffer the headers so they are sent with the first write() call
# This reduces the number of TCP packets we are sending
- $self->{_header_buf} = join("\x0D\x0A", @headers, '');
+ $self->_header_buf( join("\x0D\x0A", @headers, '') );
}
=head2 $self->finalize_read($c)
return unless *STDOUT->opened();
# Prepend the headers if they have not yet been sent
- if ( my $headers = delete $self->{_header_buf} ) {
- $buffer = $headers . $buffer;
+ if ( $self->_has_header_buf ) {
+ $buffer = $self->_clear_header_buf . $buffer;
}
my $ret = $self->$orig($c, $buffer);
if ( !defined $ret ) {
- $self->{_write_error} = $!;
+ $self->_write_error($!);
DEBUG && warn "write: Failed to write response ($!)\n";
}
else {
$options ||= {};
- $self->{options} = $options;
+ $self->options($options);
if ($options->{background}) {
my $child = fork;
$self->_handler( $class, $port, $method, $uri, $protocol );
- if ( my $error = delete $self->{_write_error} ) {
+ if ( $self->_has_write_error ) {
close Remote;
if ( !defined $pid ) {
# Allow keepalive requests, this is a hack but we'll support it until
# the next major release.
- if ( delete $self->{_keepalive} ) {
+ if ( $self->_is_keepalive ) {
+ $self->_clear_keepalive;
DEBUG && warn "Reusing previous connection for keep-alive request\n";
no Moose;
+=head2 options
+
+Options hash passed to the http engine to control things like if keepalive
+is supported.
+
=head1 SEE ALSO
L<Catalyst>, L<Catalyst::Engine>
=back
-=head2 5.80000 4. Quarter 2006
+=head2 5.80000 1st Quarter 2009
Next major planned release.
=back
-=head2 5.90000 2007
+=head2 5.90000 2009
Blue Sky. Will start planning this once we land 5.8 :)
lazy => 1,
);
-#Moose ToDo:
-#can we lose the before modifiers which just call prepare_body ?
-#they are wasteful, slow us down and feel cluttery.
+# Moose TODO:
+# - Can we lose the before modifiers which just call prepare_body ?
+# they are wasteful, slow us down and feel cluttery.
# Can we call prepare_body at BUILD time?
-# Can we make _body an attribute and have the rest of these lazy build from there?
+# Can we make _body an attribute, have the rest of
+# these lazy build from there and kill all the direct hash access
+# in Catalyst.pm and Engine.pm?
has _context => (
is => 'rw',
weak_ref => 1,
handles => ['read'],
+ clearer => '_clear_context',
);
has body_parameters => (
},
);
+has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
+
no Moose;
sub args { shift->arguments(@_) }
if (@params) {
$self->uri->path(@params);
- undef $self->{path};
+ $self->_clear_path;
}
- elsif ( defined( my $path = $self->{path} ) ) {
- return $path;
+ elsif ( $self->_has_path ) {
+ return $self->_path;
}
else {
my $path = $self->uri->path;
my $location = $self->base->path;
$path =~ s/^(\Q$location\E)?//;
$path =~ s/^\///;
- $self->{path} = $path;
+ $self->_path($path);
return $path;
}
has size => (is => 'rw');
has tempname => (is => 'rw');
has type => (is => 'rw');
-has basename => (is => 'rw');
+has basename => (is => 'ro', lazy_build => 1);
has fh => (
is => 'rw',
},
);
+sub _build_basename {
+ my $self = shift;
+ my $basename = $self->filename;
+ $basename =~ s|\\|/|g;
+ $basename = ( File::Spec::Unix->splitpath($basename) )[2];
+ $basename =~ s|[^\w\.-]+|_|g;
+ return $basename;
+}
+
no Moose;
=head1 NAME
return $content;
}
-sub basename {
- my $self = shift;
- unless ( $self->{basename} ) {
- my $basename = $self->filename;
- $basename =~ s|\\|/|g;
- $basename = ( File::Spec::Unix->splitpath($basename) )[2];
- $basename =~ s|[^\w\.-]+|_|g;
- $self->{basename} = $basename;
- }
-
- return $self->{basename};
-}
-
=head2 $upload->basename
Returns basename for C<filename>.
with 'MooseX::Emulate::Class::Accessor::Fast';
has cookies => (is => 'rw', default => sub { {} });
-has body => (is => 'rw', default => '');
+has body => (is => 'rw', default => '', lazy => 1, predicate => 'has_body');
has location => (is => 'rw');
has status => (is => 'rw', default => 200);
has finalized_headers => (is => 'rw', default => 0);
is => 'rw',
weak_ref => 1,
handles => ['write'],
+ clearer => '_clear_context',
);
sub output { shift->body(@_) }
in the same fashion), or a filehandle GLOB. Catalyst
will write it piece by piece into the response.
+=head2 $res->has_body
+
+Predicate which returns true when a body has been set.
+
=head2 $res->content_encoding
Shortcut for $res->headers->content_encoding.
has tree => (
is => 'ro',
required => 1,
- default => sub{ Tree::Simple->new({t => [gettimeofday]}) }
+ default => sub{ Tree::Simple->new({t => [gettimeofday]}) },
+ handles => [qw/ accept traverse /],
);
has stack => (
is => 'ro',
my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
my @results;
- $self->tree->traverse(
+ $self->traverse(
sub {
my $action = shift;
my $stat = $action->getNodeValue;
my $visitor = Tree::Simple::Visitor::FindByUID->new;
$visitor->searchForUID($uid);
- $self->tree->accept($visitor);
+ $self->accept($visitor);
return $visitor->getResult;
}
-sub accept {
- my $self = shift;
- $self->{tree}->accept( @_ );
-}
-
sub addChild {
my $self = shift;
my $node = $_[ 0 ];
$stat->{ elapsed } =~ s{s$}{};
}
- $self->{tree}->addChild( @_ );
+ $self->tree->addChild( @_ );
}
sub setNodeValue {
$stat->{ elapsed } =~ s{s$}{};
}
- $self->{tree}->setNodeValue( @_ );
+ $self->tree->setNodeValue( @_ );
}
sub getNodeValue {
my $self = shift;
- $self->{tree}->getNodeValue( @_ )->{ t };
-}
-
-sub traverse {
- my $self = shift;
- $self->{tree}->traverse( @_ );
+ $self->tree->getNodeValue( @_ )->{ t };
}
no Moose;
{
package TestAppWithMeta;
use Catalyst;
+ no warnings 'redefine';
sub meta {}
}
projects / catagits/Catalyst-Runtime.git / commitdiff