lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use Moose;
   4 use Class::MOP;
   5 use Class::MOP::Object;
   6 use Catalyst::Utils;
   7 use Class::C3::Adopt::NEXT;
   8 use Devel::InnerPackage ();
   9 use MRO::Compat;
  10 use mro 'c3';
  11 use Scalar::Util 'blessed';
  12 use Class::Load 'is_class_loaded';
  13 use Moose::Util 'find_meta';
  14 use namespace::clean -except => 'meta';
  15
  16 with 'MooseX::Emulate::Class::Accessor::Fast';
  17 with 'Catalyst::ClassData';
  18
  19
  20 =head1 NAME
  21
  22 Catalyst::Component - Catalyst Component Base Class
  23
  24 =head1 SYNOPSIS
  25
  26     # lib/MyApp/Model/Something.pm
  27     package MyApp::Model::Something;
  28
  29     use base 'Catalyst::Component';
  30
  31     __PACKAGE__->config( foo => 'bar' );
  32
  33     has foo => (
  34         is => 'ro',
  35     );
  36
  37     sub test {
  38         my $self = shift;
  39         return $self->foo;
  40     }
  41
  42     sub forward_to_me {
  43         my ( $self, $c ) = @_;
  44         $c->response->output( $self->foo );
  45     }
  46
  47     1;
  48
  49     # Methods can be a request step
  50     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  51
  52     # Or just methods
  53     print $c->comp('MyApp::Model::Something')->test;
  54
  55     print $c->comp('MyApp::Model::Something')->foo;
  56
  57 =head1 DESCRIPTION
  58
  59 This is the universal base class for Catalyst components
  60 (Model/View/Controller).
  61
  62 It provides you with a generic new() for component construction through Catalyst's
  63 component loader with config() support and a process() method placeholder.
  64
  65 B<Note> that calling C<< $self->config >> inside a component is strongly
  66 not recommended - the correctly merged config should have already been
  67 passed to the constructor and stored in attributes - accessing
  68 the config accessor directly from an instance is likely to get the
  69 wrong values (as it only holds the class wide config, not things loaded
  70 from the config file!)
  71
  72 =cut
  73
  74 __PACKAGE__->mk_classdata('_plugins');
  75 __PACKAGE__->mk_classdata('_config');
  76
  77 has catalyst_component_name => ( is => 'ro' ); # Cannot be required => 1 as context
  78                                        # class @ISA component - HATE
  79 # Make accessor callable as a class method, as we need to call setup_actions
  80 # on the application class, which we don't have an instance of, ewwwww
  81 # Also, naughty modules like Catalyst::View::JSON try to write to _everything_,
  82 # so spit a warning, ignore that (and try to do the right thing anyway) here..
  83 around catalyst_component_name => sub {
  84     my ($orig, $self) = (shift, shift);
  85     Carp::cluck("Tried to write to the catalyst_component_name accessor - is your component broken or just mad? (Write ignored - using default value.)") if scalar @_;
  86     blessed($self) ? $self->$orig() || blessed($self) : $self;
  87 };
  88
  89 sub BUILDARGS {
  90     my $class = shift;
  91     my $args = {};
  92
  93     if (@_ == 1) {
  94         $args = $_[0] if ref($_[0]) eq 'HASH';
  95     } elsif (@_ == 2) { # is it ($app, $args) or foo => 'bar' ?
  96         if (blessed($_[0])) {
  97             $args = $_[1] if ref($_[1]) eq 'HASH';
  98         } elsif (is_class_loaded($_[0]) &&
  99                 $_[0]->isa('Catalyst') && ref($_[1]) eq 'HASH') {
 100             $args = $_[1];
 101         } else {
 102             $args = +{ @_ };
 103         }
 104     } elsif (@_ % 2 == 0) {
 105         $args = +{ @_ };
 106     }
 107
 108     return $class->merge_config_hashes( $class->config, $args );
 109 }
 110
 111 sub COMPONENT {
 112     my ( $class, $c ) = @_;
 113
 114     # Temporary fix, some components does not pass context to constructor
 115     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
 116     if ( my $next = $class->next::can ) {
 117       my ($next_package) = Class::MOP::get_code_info($next);
 118       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n";
 119       warn "This behavior can no longer be supported, and so your application is probably broken.\n";
 120       warn "Your linearized isa hierarchy is: " . join(', ', @{ mro::get_linear_isa($class) }) . "\n";
 121       warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n";
 122     }
 123     return $class->new($c, $arguments);
 124 }
 125
 126 sub config {
 127     my $self = shift;
 128     # Uncomment once sane to do so
 129     #Carp::cluck("config method called on instance") if ref $self;
 130     my $config = $self->_config || {};
 131     if (@_) {
 132         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
 133         $self->_config(
 134             $self->merge_config_hashes( $config, $newconfig )
 135         );
 136     } else {
 137         # this is a bit of a kludge, required to make
 138         # __PACKAGE__->config->{foo} = 'bar';
 139         # work in a subclass.
 140         # TODO maybe this should be a ClassData option?
 141         my $class = blessed($self) || $self;
 142         my $meta = find_meta($class);
 143         unless (${ $meta->get_or_add_package_symbol('$_config') }) {
 144             # Call merge_hashes to ensure we deep copy the parent
 145             # config onto the subclass
 146             $self->_config( Catalyst::Utils::merge_hashes($config, {}) );
 147         }
 148     }
 149     return $self->_config;
 150 }
 151
 152 sub merge_config_hashes {
 153     my ( $self, $lefthash, $righthash ) = @_;
 154
 155     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 156 }
 157
 158 sub process {
 159
 160     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 161           . " did not override Catalyst::Component::process" );
 162 }
 163
 164 sub expand_modules {
 165     my ($class, $component) = @_;
 166     return Devel::InnerPackage::list_packages( $component );
 167 }
 168
 169 __PACKAGE__->meta->make_immutable;
 170
 171 1;
 172
 173 __END__
 174
 175 =head1 METHODS
 176
 177 =head2 new($app, $arguments)
 178
 179 Called by COMPONENT to instantiate the component; should return an object
 180 to be stored in the application's component hash.
 181
 182 =head2 COMPONENT
 183
 184 C<< my $component_instance = $component->COMPONENT($app, $arguments); >>
 185
 186 If this method is present (as it is on all Catalyst::Component subclasses),
 187 it is called by Catalyst during setup_components with the application class
 188 as $app and any config entry on the application for this component (for example,
 189 in the case of MyApp::Controller::Foo this would be
 190 C<< MyApp->config('Controller::Foo' => \%conf >>).
 191
 192 The arguments are expected to be a hashref and are merged with the
 193 C<< __PACKAGE__->config >> hashref before calling C<< ->new >>
 194 to instantiate the component.
 195
 196 You can override it in your components to do custom construction, using
 197 something like this:
 198
 199   sub COMPONENT {
 200       my ($class, $app, $args) = @_;
 201       $args = $class->merge_config_hashes($class->config, $args);
 202       return $class->new($app, $args);
 203   }
 204
 205 B<NOTE:> Generally when L<Catalyst> starts, it initializes all the components
 206 and passes the hashref present in any configuration information to the
 207 COMPONENT method.  For example
 208
 209     MyApp->config(
 210       'Model::Foo' => {
 211         bar => 'baz',
 212       });
 213
 214 You would expect COMPONENT to be called like this ->COMPONENT( 'MyApp', +{ bar=>'baz'});
 215
 216 This would happen ONCE during setup.
 217
 218 =head2 $c->config
 219
 220 =head2 $c->config($hashref)
 221
 222 =head2 $c->config($key, $value, ...)
 223
 224 Accessor for this component's config hash. Config values can be set as
 225 key value pair, or you can specify a hashref. In either case the keys
 226 will be merged with any existing config settings. Each component in
 227 a Catalyst application has its own config hash.
 228
 229 The component's config hash is merged with any config entry on the
 230 application for this component and passed to C<new()> (as mentioned
 231 above at L</COMPONENT>). The recommended practice to access the merged
 232 config is to use a Moose attribute for each config entry on the
 233 receiving component.
 234
 235 =head2 $c->process()
 236
 237 This is the default method called on a Catalyst component in the dispatcher.
 238 For instance, Views implement this action to render the response body
 239 when you forward to them. The default is an abstract method.
 240
 241 =head2 $c->merge_config_hashes( $hashref, $hashref )
 242
 243 Merges two hashes together recursively, giving right-hand precedence.
 244 Alias for the method in L<Catalyst::Utils>.
 245
 246 =head2 $c->expand_modules( $setup_component_config )
 247
 248 Return a list of extra components that this component has created. By default,
 249 it just looks for a list of inner packages of this component
 250
 251 =cut
 252
 253 =head1 OPTIONAL METHODS
 254
 255 =head2 ACCEPT_CONTEXT($c, @args)
 256
 257 Catalyst components are normally initialized during server startup, either
 258 as a Class or a Instance. However, some components require information about
 259 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 260
 261 If this method is present, it is called during $c->comp/controller/model/view
 262 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 263 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 264 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 265 calling code in the application rather than the component itself.
 266
 267 B<NOTE:> All classes that are L<Catalyst::Component>s will have a COMPONENT
 268 method, but classes that are intended to be factories or generators will
 269 have ACCEPT_CONTEXT.  If you have initialization arguments (such as from
 270 configuration) that you wish to expose to the ACCEPT_CONTEXT you should
 271 proxy them in the factory instance.  For example:
 272
 273     MyApp::Model::FooFactory;
 274
 275     use Moose;
 276     extends 'Catalyst::Model';
 277
 278     has type => (is=>'ro', required=>1);
 279
 280     sub ACCEPT_CONTEXT {
 281       my ($self, $c, @args) = @_;
 282       return bless { args=>\@args }, $self->type;
 283     }
 284
 285     MyApp::Model::Foo->meta->make_immutable;
 286     MyApp::Model::Foo->config( type => 'Type1' );
 287
 288 And in a controller:
 289
 290     my $type = $c->model('FooFactory', 1,2,3,4): # $type->isa('Type1')
 291
 292 B<NOTE:> If you define a ACCEPT_CONTEXT method it MUST check to see if the
 293 second argument is blessed (is a context) or not (is an application class name) and
 294 it MUST return something valid for the case when the scope is application.  This is
 295 required because a component maybe be called from the application scope even if it
 296 requires a context and you must prevent errors from being issued if this happens.
 297 Remember not all components that ACCEPT_CONTEXT actually need or use context information
 298 (and there is a school of thought that suggestions doing so is a design error anyway...)
 299
 300 =head1 SEE ALSO
 301
 302 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 303
 304 =head1 AUTHORS
 305
 306 Catalyst Contributors, see Catalyst.pm
 307
 308 =head1 COPYRIGHT
 309
 310 This library is free software. You can redistribute it and/or modify it under
 311 the same terms as Perl itself.
 312
 313 =cut