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