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