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