#I imagine that very few of these really need to be class variables. if any.
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
- for qw/components arguments dispatcher engine log dispatcher_class
+ for qw/container components arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class stats_class
setup_finished/;
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.80024';
+our $VERSION = '5.80032';
sub import {
my ( $class, @arguments ) = @_;
$meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
unless( $meta->has_method('meta') ){
- $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
+ if ($Moose::VERSION >= 1.15) {
+ $meta->_add_meta_method('meta');
+ }
+ else {
+ $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
+ }
}
$caller->arguments( [@arguments] );
and access it from the stash.
+Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
+
=cut
sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
C<go> escapes the processing of the current request chain on completion, and
does not return to its caller.
+@arguments are arguments to the final destination of $action. @captures are
+arguments to the intermediate steps, if any, on the way to the final sub of
+$action.
+
=cut
sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
$filter = qr/$filter/; # Compile regex now rather than once per loop
+ my @components = map { $c->container->get_sub_container($_)->get_service_list } qw(controller view model);
+
# map the original component name to the sub part that we will search against
my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
- grep { /$filter/ } keys %{ $c->components };
+ grep { /$filter/ } @components;
# undef for a name will return all
return keys %eligible if !defined $name;
my $appclass = ref($c) || $c;
if( $name ) {
unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
- my $comps = $c->components;
my $check = $appclass."::Controller::".$name;
- return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ my $container = $c->container->get_sub_container('controller');
+ return $c->_filter_component( $container->resolve(service => "$check"), @args )
+ if $container->has_service($check);
}
my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
my $appclass = ref($c) || $c;
if( $name ) {
unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
- my $comps = $c->components;
my $check = $appclass."::Model::".$name;
- return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ my $container = $c->container->get_sub_container('model');
+ return $c->_filter_component( $container->resolve(service => "$check"), @args )
+ if $container->has_service($check);
}
my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
my $appclass = ref($c) || $c;
if( $name ) {
unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
- my $comps = $c->components;
my $check = $appclass."::View::".$name;
- return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+ my $container = $c->container->get_sub_container('view');
+ if ($container->has_service($check)) {
+
+ return $c->_filter_component( $container->resolve(service => $check), @args );
+ }
+ else {
+ $c->log->warn( "Attempted to use view '$check', but does not exist" );
+ }
}
my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
sub controllers {
my ( $c ) = @_;
- return $c->_comp_names(qw/Controller C/);
+ return $c->container->get_sub_container('controller')->get_service_list;
}
=head2 $c->models
sub models {
my ( $c ) = @_;
- return $c->_comp_names(qw/Model M/);
+ return $c->container->get_sub_container('model')->get_service_list;
}
sub views {
my ( $c ) = @_;
- return $c->_comp_names(qw/View V/);
+ return $c->container->get_sub_container('view')->get_service_list;
}
=head2 $c->comp($name)
use Moose;
# this attr will receive 'baz' at construction time
- has 'bar' => (
+ has 'bar' => (
is => 'rw',
isa => 'Str',
);
You can then get the value 'baz' by calling $c->model('Foo')->bar
+(or $self->bar inside code in the model).
+
+B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
+as a way of reading config within your code, as this B<will not> give you the
+correctly merged config back. You B<MUST> take the config values supplied to
+the constructor and use those instead.
=cut
}
}
+ $class->setup_config();
$class->setup_home( delete $flags->{home} );
$class->setup_log( delete $flags->{log} );
A hook to attach modifiers to. This method does not do anything except set the
C<setup_finished> accessor.
-Applying method modifiers to the C<setup> method doesn't work, because of quirky thingsdone for plugin setup.
+Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
Example:
Constructs an absolute L<URI> object based on the application root, the
provided path, and the additional arguments and query parameters provided.
-When used as a string, provides a textual URI.
+When used as a string, provides a textual URI. If you need more flexibility
+than this (i.e. the option to provide relative URIs etc.) see
+L<Catalyst::Plugin::SmartURI>.
If no arguments are provided, the URI for the current action is returned.
To return the current action and also provide @args, use
Returns a hash of components.
+=cut
+
+around components => sub {
+ my $orig = shift;
+ my $class = shift;
+ my $comps = shift;
+
+ return $class->$orig if ( !$comps );
+
+# FIXME: should this ugly kludge exist?
+ $class->setup_config unless defined $class->container;
+
+# FIXME: should there be a warning here, not to use this accessor to create the components?
+ my $components = {};
+
+ my $containers;
+ $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
+ for my $component ( keys %$comps ) {
+ $components->{ $component } = $comps->{$component};
+
+ my $type = _get_component_type($component);
+
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+ }
+
+ return $class->$orig($components);
+};
+
=head2 $c->context_class
Returns or sets the context class.
push( @{ $c->stack }, $code );
no warnings 'recursion';
- eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
+ # N.B. This used to be combined, but I have seen $c get clobbered if so, and
+ # I have no idea how, ergo $ret (which appears to fix the issue)
+ eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
$error = qq/Caught exception in $class->$name "$error"/;
}
$c->error($error);
- $c->state(0);
}
+ $c->state(0);
}
return $c->state;
}
my $parent = $c->stack->[-1];
# forward, locate the caller
- if ( exists $c->counter->{"$parent"} ) {
+ if ( defined $parent && exists $c->counter->{"$parent"} ) {
$c->stats->profile(
begin => $action,
parent => "$parent" . $c->counter->{"$parent"},
}
# Content-Length
- if ( $response->body && !$response->content_length ) {
+ if ( defined $response->body && length $response->body && !$response->content_length ) {
# get the length from a filehandle
- if ( blessed( $response->body ) && $response->body->can('read') )
+ if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
{
my $stat = stat $response->body;
if ( $stat && $stat->size > 0 ) {
$c->log->debug("Query keywords are: $keywords");
}
- $c->log_request_parameters( query => $request->query_parameters, body => $request->body_parameters );
+ $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
$c->log_request_uploads($request);
}
=head2 $c->request_class
-Returns or sets the request class.
+Returns or sets the request class. Defaults to L<Catalyst::Request>.
=head2 $c->response_class
-Returns or sets the response class.
+Returns or sets the response class. Defaults to L<Catalyst::Response>.
=head2 $c->read( [$maxlength] )
sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
+=head2 $c->setup_config
+
+=cut
+
+sub setup_config {
+ my $class = shift;
+
+ my %args = %{ $class->config || {} };
+
+ my @container_classes = ( "${class}::Container", 'Catalyst::Container');
+ unshift @container_classes, delete $args{container_class} if exists $args{container_class};
+
+ my $container_class = Class::MOP::load_first_existing_class(@container_classes);
+
+ my $container = $container_class->new( %args, name => "$class" );
+ $class->container($container);
+
+ my $config = $container->resolve(service => 'config');
+ $class->config($config);
+ $class->finalize_config; # back-compat
+}
+
+=head $c->finalize_config
+
+=cut
+
+sub finalize_config { }
+
=head2 $c->setup_components
This method is called internally to set up the application's components.
my $config = $class->config->{ setup_components };
- my @comps = sort { length $a <=> length $b }
- $class->locate_components($config);
+ my @comps = $class->locate_components($config);
my %comps = map { $_ => 1 } @comps;
my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
}
+ my $containers;
+ $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
for my $component (@comps) {
my $instance = $class->components->{ $component } = $class->setup_component($component);
+ if ( my $type = _get_component_type($component) ) {
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $instance } ));
+ }
my @expanded_components = $instance->can('expand_modules')
? $instance->expand_modules( $component, $config )
: $class->expand_component_module( $component, $config );
for my $component (@expanded_components) {
next if $comps{$component};
+
+ $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components;
+ $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
+ qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
+ ) if $deprecatedcatalyst_component_names;
+
+ if (my $type = _get_component_type($component)) {
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+ }
+
$class->components->{ $component } = $class->setup_component($component);
}
}
}
+sub _get_component_type {
+ my $component = shift;
+ my @parts = split /::/, $component;
+
+ for (@parts) {
+ return 'controller' if /^c|controller$/i;
+ return 'model' if /^m|model$/i;
+ return 'view' if /^v|view$/i;
+ }
+}
+
=head2 $c->locate_components( $setup_component_config )
This method is meant to provide a list of component modules that should be
%$config
);
- my @comps = $locator->plugins;
+ # XXX think about ditching this sort entirely
+ my @comps = sort { length $a <=> length $b } $locator->plugins;
return @comps;
}
message => qq/Couldn't instantiate component "$component", "$error"/
);
}
-
- unless (blessed $instance) {
+ elsif (!blessed $instance) {
my $metaclass = Moose::Util::find_meta($component);
my $method_meta = $metaclass->find_method_by_name('COMPONENT');
my $component_method_from = $method_meta->associated_metaclass->name;
qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
);
}
+
return $instance;
}
rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
+dd070: Dhaval Dhanani <dhaval070@gmail.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
+
=head1 LICENSE
This library is free software. You can redistribute it and/or modify it under
projects / catagits/Catalyst-Runtime.git / blobdiff