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 not recommended - 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 # Naughty modules like Catalyst::View::JSON try to write to _everything_,
  78 # so spit a warning, ignore that (and try to do the right thing anyway) here..
  79 around catalyst_component_name => sub {
  80     my ($orig, $self) = (shift, shift);
  81     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 @_;
  82     return $self->$orig() || blessed($self);
  83 };
  84
  85 sub BUILDARGS {
  86     my $class = shift;
  87     my $args = {};
  88
  89     if (@_ == 1) {
  90         $args = $_[0] if ref($_[0]) eq 'HASH';
  91     } elsif (@_ == 2) { # is it ($app, $args) or foo => 'bar' ?
  92         if (blessed($_[0])) {
  93             $args = $_[1] if ref($_[1]) eq 'HASH';
  94         } elsif (Class::MOP::is_class_loaded($_[0]) &&
  95                 $_[0]->isa('Catalyst') && ref($_[1]) eq 'HASH') {
  96             $args = $_[1];
  97         } else {
  98             $args = +{ @_ };
  99         }
 100     } elsif (@_ % 2 == 0) {
 101         $args = +{ @_ };
 102     }
 103
 104     return $class->merge_config_hashes( $class->config, $args );
 105 }
 106
 107 sub COMPONENT {
 108     my ( $class, $c ) = @_;
 109
 110     # Temporary fix, some components does not pass context to constructor
 111     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
 112     if ( my $next = $class->next::can ) {
 113       my ($next_package) = Class::MOP::get_code_info($next);
 114       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n";
 115       warn "This behavior can no longer be supported, and so your application is probably broken.\n";
 116       warn "Your linearized isa hierarchy is: " . join(', ', @{ mro::get_linear_isa($class) }) . "\n";
 117       warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n";
 118     }
 119     return $class->new($c, $arguments);
 120 }
 121
 122 sub config {
 123     my $self = shift;
 124     # Uncomment once sane to do so
 125     #Carp::cluck("config method called on instance") if ref $self;
 126     my $config = $self->_config || {};
 127     if (@_) {
 128         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
 129         $self->_config(
 130             $self->merge_config_hashes( $config, $newconfig )
 131         );
 132     } else {
 133         # this is a bit of a kludge, required to make
 134         # __PACKAGE__->config->{foo} = 'bar';
 135         # work in a subclass.
 136         # TODO maybe this should be a ClassData option?
 137         my $class = blessed($self) || $self;
 138         my $meta = Class::MOP::get_metaclass_by_name($class);
 139         unless (${ $meta->get_or_add_package_symbol('$_config') }) {
 140             # Call merge_hashes to ensure we deep copy the parent
 141             # config onto the subclass
 142             $self->_config( Catalyst::Utils::merge_hashes($config, {}) );
 143         }
 144     }
 145     return $self->_config;
 146 }
 147
 148 sub merge_config_hashes {
 149     my ( $self, $lefthash, $righthash ) = @_;
 150
 151     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 152 }
 153
 154 sub process {
 155
 156     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 157           . " did not override Catalyst::Component::process" );
 158 }
 159
 160 sub expand_modules {
 161     my ($class, $component) = @_;
 162     return Devel::InnerPackage::list_packages( $component );
 163 }
 164
 165 __PACKAGE__->meta->make_immutable;
 166
 167 1;
 168
 169 __END__
 170
 171 =head1 METHODS
 172
 173 =head2 new($app, $arguments)
 174
 175 Called by COMPONENT to instantiate the component; should return an object
 176 to be stored in the application's component hash.
 177
 178 =head2 COMPONENT
 179
 180 C<< my $component_instance = $component->COMPONENT($app, $arguments); >>
 181
 182 If this method is present (as it is on all Catalyst::Component subclasses),
 183 it is called by Catalyst during setup_components with the application class
 184 as $app and any config entry on the application for this component (for example,
 185 in the case of MyApp::Controller::Foo this would be
 186 C<< MyApp->config('Controller::Foo' => \%conf >>).
 187
 188 The arguments are expected to be a hashref and are merged with the
 189 C<< __PACKAGE__->config >> hashref before calling C<< ->new >>
 190 to instantiate the component.
 191
 192 You can override it in your components to do custom construction, using
 193 something like this:
 194
 195   sub COMPONENT {
 196       my ($class, $app, $args) = @_;
 197       $args = $class->merge_config_hashes($class->config, $args);
 198       return $class->new($app, $args);
 199   }
 200
 201 =head2 $c->config
 202
 203 =head2 $c->config($hashref)
 204
 205 =head2 $c->config($key, $value, ...)
 206
 207 Accessor for this component's config hash. Config values can be set as
 208 key value pair, or you can specify a hashref. In either case the keys
 209 will be merged with any existing config settings. Each component in
 210 a Catalyst application has its own config hash.
 211
 212 The component's config hash is merged with any config entry on the
 213 application for this component and passed to C<new()> (as mentioned
 214 above at L</COMPONENT>). The recommended practice to access the merged
 215 config is to use a Moose attribute for each config entry on the
 216 receiving component.
 217
 218 =head2 $c->process()
 219
 220 This is the default method called on a Catalyst component in the dispatcher.
 221 For instance, Views implement this action to render the response body
 222 when you forward to them. The default is an abstract method.
 223
 224 =head2 $c->merge_config_hashes( $hashref, $hashref )
 225
 226 Merges two hashes together recursively, giving right-hand precedence.
 227 Alias for the method in L<Catalyst::Utils>.
 228
 229 =head2 $c->expand_modules( $setup_component_config )
 230
 231 Return a list of extra components that this component has created. By default,
 232 it just looks for a list of inner packages of this component
 233
 234 =cut
 235
 236 =head1 OPTIONAL METHODS
 237
 238 =head2 ACCEPT_CONTEXT($c, @args)
 239
 240 Catalyst components are normally initialized during server startup, either
 241 as a Class or a Instance. However, some components require information about
 242 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 243
 244 If this method is present, it is called during $c->comp/controller/model/view
 245 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 246 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 247 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 248 calling code in the application rather than the component itself.
 249
 250 =head1 SEE ALSO
 251
 252 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 253
 254 =head1 AUTHORS
 255
 256 Catalyst Contributors, see Catalyst.pm
 257
 258 =head1 COPYRIGHT
 259
 260 This library is free software. You can redistribute it and/or modify it under
 261 the same terms as Perl itself.
 262
 263 =cut