From: Tomas Doran Date: Mon, 8 Dec 2008 01:11:23 +0000 (+0000) Subject: Do a load of small refatoring to remove direct hash accesses, update todo, bump dates... X-Git-Tag: 5.8000_05~101 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=025703186d05624d36984961c75a1e138eaed850;hp=24e6a237112fbbd4ab37bce0060e6cfe18adcb83 Do a load of small refatoring to remove direct hash accesses, update todo, bump dates in roadmap - however that needs a proper update --- diff --git a/Changes b/Changes index b149b5d..67ea177 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,18 @@ # 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 diff --git a/TODO b/TODO index 0aa40d8..7e28328 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,7 @@ - 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. @@ -20,14 +20,20 @@ - 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. diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 7fdb797..8480fca 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1537,8 +1537,7 @@ sub finalize_headers { $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{

This item has moved here.

} diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index df046cb..b751ba3 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -16,6 +16,8 @@ use Scalar::Util (); 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 @@ -123,8 +125,8 @@ sub finalize_error { $name = "

$name

"; # 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}; @@ -618,9 +620,9 @@ Writes the buffer to the client. 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; diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm index 2c2fc87..fa2e23e 100644 --- a/lib/Catalyst/Engine/CGI.pm +++ b/lib/Catalyst/Engine/CGI.pm @@ -4,6 +4,7 @@ use Moose; extends 'Catalyst::Engine'; has env => (is => 'rw'); +has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf'); =head1 NAME @@ -41,8 +42,7 @@ sub finalize_headers { $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) @@ -216,8 +216,8 @@ around write => sub { 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 ); diff --git a/lib/Catalyst/Engine/FastCGI.pm b/lib/Catalyst/Engine/FastCGI.pm index 1e726e7..f716325 100644 --- a/lib/Catalyst/Engine/FastCGI.pm +++ b/lib/Catalyst/Engine/FastCGI.pm @@ -159,9 +159,9 @@ sub run { 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 @@ -169,8 +169,8 @@ sub write { # 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', diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm index 6318f2d..d35e604 100644 --- a/lib/Catalyst/Engine/HTTP.pm +++ b/lib/Catalyst/Engine/HTTP.pm @@ -19,6 +19,10 @@ require Catalyst::Engine::HTTP::Restarter::Watcher; 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 @@ -64,12 +68,12 @@ sub finalize_headers { # 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' ); @@ -79,7 +83,7 @@ sub finalize_headers { # 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) @@ -149,14 +153,14 @@ around write => sub { 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 { @@ -176,7 +180,7 @@ sub run { $options ||= {}; - $self->{options} = $options; + $self->options($options); if ($options->{background}) { my $child = fork; @@ -280,7 +284,7 @@ sub run { $self->_handler( $class, $port, $method, $uri, $protocol ); - if ( my $error = delete $self->{_write_error} ) { + if ( $self->_has_write_error ) { close Remote; if ( !defined $pid ) { @@ -378,7 +382,8 @@ sub _handler { # 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"; @@ -523,6 +528,11 @@ sub _inet_addr { unpack "N*", inet_aton( $_[0] ) } no Moose; +=head2 options + +Options hash passed to the http engine to control things like if keepalive +is supported. + =head1 SEE ALSO L, L diff --git a/lib/Catalyst/ROADMAP.pod b/lib/Catalyst/ROADMAP.pod index c7b1b54..70f63d1 100644 --- a/lib/Catalyst/ROADMAP.pod +++ b/lib/Catalyst/ROADMAP.pod @@ -46,7 +46,7 @@ through switches / ENV =back -=head2 5.80000 4. Quarter 2006 +=head2 5.80000 1st Quarter 2009 Next major planned release. @@ -79,7 +79,7 @@ This depends on the progress of Isotope =back -=head2 5.90000 2007 +=head2 5.90000 2009 Blue Sky. Will start planning this once we land 5.8 :) diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 595c827..48253b9 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -34,16 +34,19 @@ has headers => ( 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 => ( @@ -119,6 +122,8 @@ has hostname => ( }, ); +has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' ); + no Moose; sub args { shift->arguments(@_) } @@ -408,17 +413,17 @@ sub path { 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; } diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 384d33a..6d7073e 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -13,7 +13,7 @@ has headers => (is => 'rw'); 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', @@ -33,6 +33,15 @@ has fh => ( }, ); +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 @@ -138,19 +147,6 @@ sub slurp { 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. diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm index d417512..3203b2d 100644 --- a/lib/Catalyst/Response.pm +++ b/lib/Catalyst/Response.pm @@ -6,7 +6,7 @@ use HTTP::Headers; 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); @@ -21,6 +21,7 @@ has _context => ( is => 'rw', weak_ref => 1, handles => ['write'], + clearer => '_clear_context', ); sub output { shift->body(@_) } @@ -63,6 +64,10 @@ you might want to use a L type of object (Something that implements 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. diff --git a/lib/Catalyst/Stats.pm b/lib/Catalyst/Stats.pm index 9e24108..247e1bd 100644 --- a/lib/Catalyst/Stats.pm +++ b/lib/Catalyst/Stats.pm @@ -10,7 +10,8 @@ has enable => (is => 'rw', required => 1, default => sub{ 1 }); 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', @@ -89,7 +90,7 @@ sub report { my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] ); my @results; - $self->tree->traverse( + $self->traverse( sub { my $action = shift; my $stat = $action->getNodeValue; @@ -114,15 +115,10 @@ sub _get_uid { 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 ]; @@ -135,7 +131,7 @@ sub addChild { $stat->{ elapsed } =~ s{s$}{}; } - $self->{tree}->addChild( @_ ); + $self->tree->addChild( @_ ); } sub setNodeValue { @@ -148,17 +144,12 @@ 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; diff --git a/t/meta_method_unneeded.t b/t/meta_method_unneeded.t index 8d871d1..f083fce 100644 --- a/t/meta_method_unneeded.t +++ b/t/meta_method_unneeded.t @@ -16,6 +16,7 @@ $SIG{__DIE__} = \&Carp::confess; # Stacktrace please. { package TestAppWithMeta; use Catalyst; + no warnings 'redefine'; sub meta {} }