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