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