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