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