X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=3a6b8b0cc48c081956793812d0479f0e18ffc024;hb=f5a4863cc1d79b4321d08df702200de1244c8061;hp=381a2506469a3907eb46090f3867dec810da13cb;hpb=6323fda2e7ace0fc0aa06305c674957cedc6d025;p=catagits%2FCatalyst-Runtime.git
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 381a250..3a6b8b0 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -1,9 +1,7 @@
package Catalyst;
use Moose;
-#use MooseX::ClassAttribute;
extends 'Catalyst::Component';
-
use bytes;
use Catalyst::Exception;
use Catalyst::Log;
@@ -32,14 +30,15 @@ use Carp qw/croak carp/;
BEGIN { require 5.008001; }
-has counter => ( is => 'rw');
-has request => ( is => 'rw');
-has response => ( is => 'rw');
-has state => ( is => 'rw');
-has action => ( is => 'rw');
-has stack => ( is => 'rw');
-has namespace => ( is => 'rw');
-has stats => ( is => 'rw');
+has stack => (is => 'rw');
+has stash => (is => 'rw');
+has state => (is => 'rw');
+has stats => (is => 'rw');
+has action => (is => 'rw');
+has counter => (is => 'rw');
+has request => (is => 'rw');
+has response => (is => 'rw');
+has namespace => (is => 'rw');
attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
@@ -60,19 +59,6 @@ our $START = time;
our $RECURSION = 1000;
our $DETACH = "catalyst_detach\n";
-# class_has components => (is => 'rw');
-# class_has arguments => (is => 'rw');
-# class_has dispatcher => (is => 'rw');
-# class_has engine => (is => 'rw');
-# class_has log => (is => 'rw');
-# class_has dispatcher_class => (is => 'rw', required => 1, default => sub {'Catalyst::Dispatcher'});
-# class_has engine_class => (is => 'rw', required => 1, default => sub {'Catalyst::Engine::CGI'});
-# class_has context_class => (is => 'rw');
-# class_has request_class => (is => 'rw', required => 1, default => sub {'Catalyst::Request'});
-# class_has response_class => (is => 'rw', required => 1, default => sub {'Catalyst::Response'});
-# class_has stats_class => (is => 'rw', required => 1, default => sub {'Catalyst::Stats'});
-# class_has setup_finished => (is => 'rw');
-
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class stats_class
@@ -97,12 +83,15 @@ sub import {
my $caller = caller(0);
+ #why does called have to ISA Catalyst and ISA Controller ?
unless ( $caller->isa('Catalyst') ) {
no strict 'refs';
- push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
- #my $caller_meta = $caller->meta;
- #my @isa = $caller_meta->superclasses;
- #$caller_meta->superclasses(@isa, $class, 'Catalyst::Controller');
+ if( $caller->can('meta') ){
+ my @superclasses = ($caller->meta->superclasses, $class, 'Catalyst::Controller');
+ $caller->meta->superclasses(@superclasses);
+ } else {
+ push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
+ }
}
$caller->arguments( [@arguments] );
@@ -378,17 +367,18 @@ Catalyst).
=cut
-sub stash {
+around stash => sub {
+ my $orig = shift;
my $c = shift;
if (@_) {
my $stash = @_ > 1 ? {@_} : $_[0];
croak('stash takes a hash or hashref') unless ref $stash;
foreach my $key ( keys %$stash ) {
- $c->{stash}->{$key} = $stash->{$key};
+ $c->$orig()->{$key} = $stash->{$key};
}
}
- return $c->{stash};
-}
+ return $c->$orig();
+};
=head2 $c->error
@@ -786,7 +776,6 @@ sub plugin {
$class->_register_plugin( $plugin, 1 );
eval { $plugin->import };
- #MooseX::ClassAttribute::process_class_attribute($class, $name => (is => 'rw'));
$class->mk_classdata($name);
my $obj;
eval { $obj = $plugin->new(@args) };
@@ -1338,6 +1327,8 @@ sub _stats_finish_execute {
=cut
+#Why does this exist? This is no longer safe and WILL NOT WORK.
+# it doesnt seem to be used anywhere. can we remove it?
sub _localize_fields {
my ( $c, $localized, $code ) = ( @_ );
@@ -1365,8 +1356,9 @@ sub finalize {
}
# Allow engine to handle finalize flow (for POE)
- if ( $c->engine->can('finalize') ) {
- $c->engine->finalize($c);
+ my $engine = $c->engine;
+ if ( my $code = $engine->can('finalize') ) {
+ $engine->$code($c);
}
else {
@@ -1430,31 +1422,35 @@ Finalizes headers.
sub finalize_headers {
my $c = shift;
+ my $response = $c->response; #accessor calls can add up?
+
+ # Moose TODO: Maybe this should be an attribute too?
# Check if we already finalized headers
- return if $c->response->{_finalized_headers};
+ return if $response->{_finalized_headers};
# Handle redirects
- if ( my $location = $c->response->redirect ) {
+ if ( my $location = $response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
- $c->response->header( Location => $location );
+ $response->header( Location => $location );
- if ( !$c->response->body ) {
+ #Moose TODO: we should probably be using a predicate method here ?
+ if ( !$response->body ) {
# Add a default body if none is already present
- $c->response->body(
+ $response->body(
qq{This item has moved here.
}
);
}
}
# Content-Length
- if ( $c->response->body && !$c->response->content_length ) {
+ if ( $response->body && !$response->content_length ) {
# get the length from a filehandle
- if ( blessed( $c->response->body ) && $c->response->body->can('read') )
+ if ( blessed( $response->body ) && $response->body->can('read') )
{
- my $stat = stat $c->response->body;
+ my $stat = stat $response->body;
if ( $stat && $stat->size > 0 ) {
- $c->response->content_length( $stat->size );
+ $response->content_length( $stat->size );
}
else {
$c->log->warn('Serving filehandle without a content-length');
@@ -1462,14 +1458,14 @@ sub finalize_headers {
}
else {
# everything should be bytes at this point, but just in case
- $c->response->content_length( bytes::length( $c->response->body ) );
+ $response->content_length( bytes::length( $response->body ) );
}
}
# Errors
- if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
- $c->response->headers->remove_header("Content-Length");
- $c->response->body('');
+ if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
+ $response->headers->remove_header("Content-Length");
+ $response->body('');
}
$c->finalize_cookies;
@@ -1477,7 +1473,7 @@ sub finalize_headers {
$c->engine->finalize_headers( $c, @_ );
# Done
- $c->response->{_finalized_headers} = 1;
+ $response->{_finalized_headers} = 1;
}
=head2 $c->finalize_output
@@ -1562,6 +1558,8 @@ sub prepare {
my ( $class, @arguments ) = @_;
$class->context_class( ref $class || $class ) unless $class->context_class;
+ #Moose TODO: if we make empty containers the defaults then that can be
+ #handled by the context class itself instead of having this here
my $c = $class->context_class->new(
{
counter => {},
@@ -1601,6 +1599,7 @@ sub prepare {
$c->request->_context($c);
$c->response->_context($c);
+ #XXX reuse coderef from can
# Allow engine to direct the prepare flow (for POE)
if ( $c->engine->can('prepare') ) {
$c->engine->prepare( $c, @arguments );
@@ -1652,6 +1651,7 @@ Prepares message body.
sub prepare_body {
my $c = shift;
+ #Moose TODO: what is _body ??
# Do we run for the first time?
return if defined $c->request->{_body};
@@ -1901,6 +1901,7 @@ sub setup_components {
# we know M::P::O found a file on disk so this is safe
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
+ #Class::MOP::load_class($component);
my $module = $class->setup_component( $component );
my %modules = (
@@ -1970,9 +1971,10 @@ sub setup_dispatcher {
$dispatcher = $class->dispatcher_class;
}
- unless (Class::Inspector->loaded($dispatcher)) {
- require Class::Inspector->filename($dispatcher);
- }
+ Class::MOP::load_class($dispatcher);
+ #unless (Class::Inspector->loaded($dispatcher)) {
+ # require Class::Inspector->filename($dispatcher);
+ #}
# dispatcher instance
$class->dispatcher( $dispatcher->new );
@@ -2058,9 +2060,10 @@ sub setup_engine {
$engine = $class->engine_class;
}
- unless (Class::Inspector->loaded($engine)) {
- require Class::Inspector->filename($engine);
- }
+ Class::MOP::load_class($engine);
+ #unless (Class::Inspector->loaded($engine)) {
+ # require Class::Inspector->filename($engine);
+ #}
# check for old engines that are no longer compatible
my $old_engine;
@@ -2115,7 +2118,9 @@ sub setup_home {
$home = Catalyst::Utils::home($class);
}
+ #I remember recently being scolded for assigning config values like this
if ($home) {
+ #I remember recently being scolded for assigning config values like this
$class->config->{home} ||= $home;
$class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
}
@@ -2137,6 +2142,7 @@ sub setup_log {
my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
if ( defined($env_debug) ? $env_debug : $debug ) {
no strict 'refs';
+ #Moose todo: dying to be made a bool attribute
*{"$class\::debug"} = sub { 1 };
$class->log->debug('Debug messages enabled');
}
@@ -2162,6 +2168,7 @@ sub setup_stats {
my $env = Catalyst::Utils::env_value( $class, 'STATS' );
if ( defined($env) ? $env : ($stats || $class->debug ) ) {
no strict 'refs';
+ #Moose todo: dying to be made a bool attribute
*{"$class\::use_stats"} = sub { 1 };
$class->log->debug('Statistics enabled');
}
@@ -2205,8 +2212,12 @@ the plugin name does not begin with C.
$proto->_plugins->{$plugin} = 1;
unless ($instant) {
no strict 'refs';
- unshift @{"$class\::ISA"}, $plugin;
- # $class->meta->superclasses($plugin, $class->meta->superclasses);
+ if( $class->can('meta') ){
+ my @superclasses = ($plugin, $class->meta->superclasses );
+ $class->meta->superclasses(@superclasses);
+ } else {
+ unshift @{"$class\::ISA"}, $plugin;
+ }
}
return $class;
}