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