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