[Catalyst-commits] r7511 - in Catalyst-Runtime/5.80/branches/moose:
. lib lib/Catalyst
groditi at dev.catalyst.perl.org
groditi at dev.catalyst.perl.org
Mon Mar 17 19:41:17 GMT 2008
Author: groditi
Date: 2008-03-17 19:41:17 +0000 (Mon, 17 Mar 2008)
New Revision: 7511
Added:
Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/ClassData.pm
Modified:
Catalyst-Runtime/5.80/branches/moose/Makefile.PL
Catalyst-Runtime/5.80/branches/moose/lib/Catalyst.pm
Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/AttrContainer.pm
Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm
Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Controller.pm
Log:
some tests fail and some things are ugly, but i think its a small step forward
Modified: Catalyst-Runtime/5.80/branches/moose/Makefile.PL
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/Makefile.PL 2008-03-17 16:21:52 UTC (rev 7510)
+++ Catalyst-Runtime/5.80/branches/moose/Makefile.PL 2008-03-17 19:41:17 UTC (rev 7511)
@@ -1,11 +1,13 @@
use inc::Module::Install 0.64;
-use 5.008001;
+use 5.008001;
perl_version '5.8.1';
name 'Catalyst-Runtime';
all_from 'lib/Catalyst/Runtime.pm';
+requires 'MooseX::Emulate::Class::Accessor::Fast';
+
requires 'perl' => '5.8.1';
requires 'Carp';
requires 'Class::Accessor::Fast';
@@ -38,7 +40,7 @@
build_requires 'Test::Pod' => 1.14;
build_requires 'Test::Pod::Coverage' => 1.04;
- if ($^O eq 'darwin') {
+ if ($^O eq 'darwin') {
my $osx_ver = `/usr/bin/sw_vers -productVersion`;
chomp $osx_ver;
@@ -48,7 +50,7 @@
makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}.
qq{ echo "You must set the ENV variable $attr to true,"; }.
- ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
+ ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
}
}
@@ -68,7 +70,7 @@
perl -MCPANPLUS -e 'install Catalyst::Devel' # or
perl -MCPAN -e 'install Catalyst::Devel'
- To get some commonly used plugins, as well as the TT view and DBIC
+ To get some commonly used plugins, as well as the TT view and DBIC
model, install Task::Catalyst in the same way.
Have fun!
Modified: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/AttrContainer.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/AttrContainer.pm 2008-03-17 16:21:52 UTC (rev 7510)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/AttrContainer.pm 2008-03-17 19:41:17 UTC (rev 7511)
@@ -1,18 +1,9 @@
package Catalyst::AttrContainer;
use Moose;
-#use strict;
-#use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
-
use Catalyst::Exception;
-use NEXT;
-#dont want to ISA a C::D::I
-use Class::Data::Inheritable;
-{
- my $mk_classdata = Class::Data::Inheritable->can('mk_classdata');
- __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata);
-}
+with 'Catalyst::ClassData';
__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
__PACKAGE__->_attr_cache( {} );
Added: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/ClassData.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/ClassData.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/ClassData.pm 2008-03-17 19:41:17 UTC (rev 7511)
@@ -0,0 +1,29 @@
+package Catalyst::ClassData;
+
+use Moose::Role;
+use Scalar::Util 'blessed';
+
+sub mk_classdata {
+ my ($declaredclass, $attribute, $data) = @_;
+ confess("mk_classdata() is a class method, not an object method")
+ if ref $declaredclass;
+
+ my $accessor = sub {
+ my $wantclass = blessed($_[0]) || $_[0];
+
+ return $wantclass->mk_classdata($attribute)->(@_)
+ if @_>1 && $wantclass ne $declaredclass;
+
+ $data = $_[1] if @_>1;
+ return $data;
+ };
+
+ my $alias = "_${attribute}_accessor";
+ $declaredclass->meta->add_method($alias, $accessor);
+ $declaredclass->meta->add_method($attribute, $accessor);
+ return $accessor;
+}
+
+1;
+
+__END__
Modified: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm 2008-03-17 16:21:52 UTC (rev 7510)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm 2008-03-17 19:41:17 UTC (rev 7511)
@@ -1,11 +1,14 @@
package Catalyst::Component;
-use strict;
-use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
-use NEXT;
+use Moose;
+use MooseX::Adopt::Class::Accessor::Fast;
use Catalyst::Utils;
+with 'MooseX::Emulate::Class::Accessor::Fast';
+with 'Catalyst::ClassData';
+
+
=head1 NAME
Catalyst::Component - Catalyst Component Base Class
@@ -28,7 +31,7 @@
my ( $self, $c ) = @_;
$c->response->output( $self->{foo} );
}
-
+
1;
# Methods can be a request step
@@ -41,7 +44,7 @@
=head1 DESCRIPTION
-This is the universal base class for Catalyst components
+This is the universal base class for Catalyst components
(Model/View/Controller).
It provides you with a generic new() for instantiation through Catalyst's
@@ -51,38 +54,38 @@
__PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
-
-
-sub new {
+around new => sub {
+ my $orig = shift;
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- return $self->NEXT::new(
- $self->merge_config_hashes( $self->config, $arguments ) );
-}
+ my $args = $self->merge_config_hashes( $self->config, $arguments );
+ return $self->$orig( $args );
+};
sub COMPONENT {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
+ $self->new($c, $arguments);
- if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
- return $new;
- }
- else {
- if ( my $new = $self->new( $c, $arguments ) ) {
- return $new;
- }
- else {
- my $class = ref $self || $self;
- my $new = $self->merge_config_hashes(
- $self->config, $arguments );
- return bless $new, $class;
- }
- }
+# if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
+# return $new;
+# }
+# else {
+# if ( my $new = $self->new( $c, $arguments ) ) {
+# return $new;
+# }
+# else {
+# my $class = ref $self || $self;
+# my $new = $self->merge_config_hashes(
+# $self->config, $arguments );
+# return bless $new, $class;
+# }
+# }
}
sub config {
@@ -143,8 +146,8 @@
it is called by Catalyst during setup_components with the application class
as $c and any config entry on the application for this component (for example,
in the case of MyApp::Controller::Foo this would be
-MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
-hashref and are merged with the __PACKAGE__->config hashref before calling
+MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
+hashref and are merged with the __PACKAGE__->config hashref before calling
->new to instantiate the component.
=head2 $c->config
@@ -153,15 +156,15 @@
=head2 $c->config($key, $value, ...)
-Accessor for this component's config hash. Config values can be set as
+Accessor for this component's config hash. Config values can be set as
key value pair, or you can specify a hashref. In either case the keys
-will be merged with any existing config settings. Each component in
+will be merged with any existing config settings. Each component in
a Catalyst application has it's own config hash.
=head2 $c->process()
This is the default method called on a Catalyst component in the dispatcher.
-For instance, Views implement this action to render the response body
+For instance, Views implement this action to render the response body
when you forward to them. The default is an abstract method.
=head2 $c->merge_config_hashes( $hashref, $hashref )
Modified: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Controller.pm 2008-03-17 16:21:52 UTC (rev 7510)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Controller.pm 2008-03-17 19:41:17 UTC (rev 7511)
@@ -1,7 +1,7 @@
package Catalyst::Controller;
use strict;
-use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/;
+use base qw/Catalyst::Component Catalyst::AttrContainer/;
use Catalyst::Exception;
use Catalyst::Utils;
@@ -17,9 +17,9 @@
package MyApp::Controller::Search
use base qw/Catalyst::Controller/;
- sub foo : Local {
+ sub foo : Local {
my ($self,$c, at args) = @_;
- ...
+ ...
} # Dispatches to /search/foo
=head1 DESCRIPTION
@@ -181,7 +181,7 @@
unless ( Class::Inspector->loaded($class) ) {
require Class::Inspector->filename($class);
}
-
+
return $class->new( \%args );
}
@@ -310,7 +310,7 @@
will be bound to 'foo/bar'. The default Root controller is an example
of setting namespace to '' (the null string).
-=head2 path
+=head2 path
Sets 'path_prefix', as described below.
Modified: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst.pm 2008-03-17 16:21:52 UTC (rev 7510)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst.pm 2008-03-17 19:41:17 UTC (rev 7511)
@@ -1,7 +1,7 @@
package Catalyst;
-use strict;
-use base 'Catalyst::Component';
+use Moose;
+extends 'Catalyst::Component';
use bytes;
use Catalyst::Exception;
use Catalyst::Log;
@@ -31,7 +31,7 @@
BEGIN { require 5.008001; }
__PACKAGE__->mk_accessors(
- qw/counter request response state action stack namespace stats/
+ qw/counter request response state action stack namespace stats stash/
);
attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
@@ -54,7 +54,7 @@
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
- engine_class context_class request_class response_class stats_class
+ engine_class context_class request_class response_class stats_class
setup_finished/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
@@ -112,30 +112,30 @@
### in lib/MyApp.pm
use Catalyst qw/-Debug/; # include plugins here as well
-
+
### In lib/MyApp/Controller/Root.pm (autocreated)
sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
$c->stash->{template} = 'foo.tt'; # set the template
# lookup something from db -- stash vars are passed to TT
- $c->stash->{data} =
+ $c->stash->{data} =
$c->model('Database::Foo')->search( { country => $args[0] } );
if ( $c->req->params->{bar} ) { # access GET or POST parameters
$c->forward( 'bar' ); # process another action
- # do something else after forward returns
+ # do something else after forward returns
}
}
-
+
# The foo.tt TT template can use the stash data from the database
[% WHILE (item = data.next) %]
[% item.foo %]
[% END %]
-
+
# called for /bar/of/soap, /bar/of/soap/10, etc.
sub bar : Path('/bar/of/soap') { ... }
# called for all actions, from the top-most controller downwards
- sub auto : Private {
+ sub auto : Private {
my ( $self, $c ) = @_;
if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
$c->res->redirect( '/login' ); # require login
@@ -143,9 +143,9 @@
}
return 1; # success; carry on to next action
}
-
+
# called after all actions are finished
- sub end : Private {
+ sub end : Private {
my ( $self, $c ) = @_;
if ( scalar @{ $c->error } ) { ... } # handle errors
return if $c->res->body; # already have a response
@@ -155,20 +155,20 @@
### in MyApp/Controller/Foo.pm
# called for /foo/bar
sub bar : Local { ... }
-
+
# called for /blargle
sub blargle : Global { ... }
-
+
# an index action matches /foo, but not /foo/1, etc.
sub index : Private { ... }
-
+
### in MyApp/Controller/Foo/Bar.pm
# called for /foo/bar/baz
sub baz : Local { ... }
-
+
# first Root auto is called, then Foo auto, then this
sub auto : Private { ... }
-
+
# powerful regular expression paths are also possible
sub details : Regex('^product/(\w+)/details$') {
my ( $self, $c ) = @_;
@@ -249,7 +249,7 @@
environment settings override the application, with <MYAPP>_STATS having the
highest priority.
-e.g.
+e.g.
use Catalyst qw/-Stats=1/
@@ -320,8 +320,8 @@
=head2 $c->detach()
-The same as C<forward>, but doesn't return to the previous action when
-processing is finished.
+The same as C<forward>, but doesn't return to the previous action when
+processing is finished.
When called with no arguments it escapes the processing chain entirely.
@@ -348,23 +348,24 @@
$c->stash->{foo} = $bar;
$c->stash( { moose => 'majestic', qux => 0 } );
$c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
-
+
# stash is automatically passed to the view for use in a template
$c->forward( 'MyApp::View::TT' );
=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
@@ -456,7 +457,7 @@
return $comp;
}
-# Find possible names for a prefix
+# Find possible names for a prefix
sub _comp_names {
my ( $c, @prefixes ) = @_;
@@ -528,7 +529,7 @@
Any extra arguments are directly passed to ACCEPT_CONTEXT.
-If the name is omitted, it will look for
+If the name is omitted, it will look for
- a model object in $c->stash{current_model_instance}, then
- a model name in $c->stash->{current_model}, then
- a config setting 'default_model', or
@@ -542,7 +543,7 @@
@args )
if $name;
if (ref $c) {
- return $c->stash->{current_model_instance}
+ return $c->stash->{current_model_instance}
if $c->stash->{current_model_instance};
return $c->model( $c->stash->{current_model} )
if $c->stash->{current_model};
@@ -573,7 +574,7 @@
Any extra arguments are directly passed to ACCEPT_CONTEXT.
-If the name is omitted, it will look for
+If the name is omitted, it will look for
- a view object in $c->stash{current_view_instance}, then
- a view name in $c->stash->{current_view}, then
- a config setting 'default_view', or
@@ -587,7 +588,7 @@
@args )
if $name;
if (ref $c) {
- return $c->stash->{current_view_instance}
+ return $c->stash->{current_view_instance}
if $c->stash->{current_view_instance};
return $c->view( $c->stash->{current_view} )
if $c->stash->{current_view};
@@ -851,7 +852,7 @@
EOF
}
-
+
if ( $class->debug ) {
my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
@@ -960,7 +961,7 @@
}
unshift(@args, $namespace || '');
}
-
+
# join args with '/', or a blank string
my $args = join('/', grep { defined($_) } @args);
$args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
@@ -1131,7 +1132,7 @@
</li>
</ul>
<h2>In conclusion</h2>
- <p>The Catalyst team hopes you will enjoy using Catalyst as much
+ <p>The Catalyst team hopes you will enjoy using Catalyst as much
as we enjoyed making it. Please contact us if you have ideas
for improvement or other feedback.</p>
</div>
@@ -1183,8 +1184,8 @@
sub dump_these {
my $c = shift;
- [ Request => $c->req ],
- [ Response => $c->res ],
+ [ Request => $c->req ],
+ [ Response => $c->res ],
[ Stash => $c->stash ],
[ Config => $c->config ];
}
@@ -1218,11 +1219,11 @@
my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
push( @{ $c->stack }, $code );
-
+
eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
-
+
my $last = pop( @{ $c->stack } );
if ( my $error = $@ ) {
@@ -1277,7 +1278,7 @@
# forward, locate the caller
if ( my $parent = $c->stack->[-1] ) {
$c->stats->profile(
- begin => $action,
+ begin => $action,
parent => "$parent" . $c->counter->{"$parent"},
uid => $uid,
);
@@ -1292,7 +1293,7 @@
}
}
else {
-
+
# root-level call
$c->stats->profile(
begin => $action,
@@ -1317,7 +1318,7 @@
my $request = delete $localized->{request} || {};
my $response = delete $localized->{response} || {};
-
+
local @{ $c }{ keys %$localized } = values %$localized;
local @{ $c->request }{ keys %$request } = values %$request;
local @{ $c->response }{ keys %$response } = values %$response;
@@ -1360,12 +1361,12 @@
$c->finalize_body;
}
-
- if ($c->use_stats) {
+
+ if ($c->use_stats) {
my $elapsed = sprintf '%f', $c->stats->elapsed;
my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
$c->log->info(
- "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
+ "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
}
return $c->response->status;
@@ -1411,7 +1412,7 @@
if ( my $location = $c->response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
$c->response->header( Location => $location );
-
+
if ( !$c->response->body ) {
# Add a default body if none is already present
$c->response->body(
@@ -1512,7 +1513,7 @@
my $c = $class->prepare(@arguments);
$c->dispatch;
- $status = $c->finalize;
+ $status = $c->finalize;
};
if ( my $error = $@ ) {
@@ -1568,7 +1569,7 @@
$c->stats($class->stats_class->new)->enable($c->use_stats);
if ( $c->debug ) {
- $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
+ $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
# For on-demand data
@@ -1590,7 +1591,7 @@
# Prepare the body for reading, either by prepare_body
# or the user, if they are using $c->read
$c->prepare_read;
-
+
# Parse the body unless the user wants it on-demand
unless ( $c->config->{parse_on_demand} ) {
$c->prepare_body;
@@ -1857,9 +1858,9 @@
my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
my $config = $class->config->{ setup_components };
my $extra = delete $config->{ search_extra } || [];
-
+
push @paths, @$extra;
-
+
my $locator = Module::Pluggable::Object->new(
search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
%$config
@@ -1867,7 +1868,7 @@
my @comps = sort { length $a <=> length $b } $locator->plugins;
my %comps = map { $_ => 1 } @comps;
-
+
for my $component ( @comps ) {
# We pass ignore_loaded here so that overlay files for (e.g.)
@@ -1881,11 +1882,11 @@
$component => $module,
map {
$_ => $class->setup_component( $_ )
- } grep {
+ } grep {
not exists $comps{$_}
} Devel::InnerPackage::list_packages( $component )
);
-
+
for my $key ( keys %modules ) {
$class->components->{ $key } = $modules{ $key };
}
@@ -2142,7 +2143,7 @@
}
-=head2 $c->registered_plugins
+=head2 $c->registered_plugins
Returns a sorted list of the plugins which have either been stated in the
import list or which have been added via C<< MyApp->plugin(@args); >>.
@@ -2274,7 +2275,7 @@
parsing with a config parameter.
MyApp->config->{parse_on_demand} = 1;
-
+
=head1 PROXY SUPPORT
Many production servers operate using the common double-server approach,
@@ -2288,9 +2289,9 @@
the frontend and backend servers on the same machine. The following
changes are made to the request.
- $c->req->address is set to the user's real IP address, as read from
+ $c->req->address is set to the user's real IP address, as read from
the HTTP X-Forwarded-For header.
-
+
The host value for $c->req->base and $c->req->uri is set to the real
host, as read from the HTTP X-Forwarded-Host header.
@@ -2302,7 +2303,7 @@
headers.
MyApp->config->{using_frontend_proxy} = 1;
-
+
If you do not wish to use the proxy support at all, you may set:
MyApp->config->{ignore_frontend_proxy} = 1;
More information about the Catalyst-commits
mailing list