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