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