lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use Moose;
   4 use Class::MOP;
   5 use MooseX::Adopt::Class::Accessor::Fast;
   6 use Catalyst::Utils;
   7 use MRO::Compat;
   8 use mro 'c3';
   9
  10 with 'MooseX::Emulate::Class::Accessor::Fast';
  11 with 'Catalyst::ClassData';
  12
  13
  14 =head1 NAME
  15
  16 Catalyst::Component - Catalyst Component Base Class
  17
  18 =head1 SYNOPSIS
  19
  20     # lib/MyApp/Model/Something.pm
  21     package MyApp::Model::Something;
  22
  23     use base 'Catalyst::Component';
  24
  25     __PACKAGE__->config( foo => 'bar' );
  26
  27     sub test {
  28         my $self = shift;
  29         return $self->{foo};
  30     }
  31
  32     sub forward_to_me {
  33         my ( $self, $c ) = @_;
  34         $c->response->output( $self->{foo} );
  35     }
  36
  37     1;
  38
  39     # Methods can be a request step
  40     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  41
  42     # Or just methods
  43     print $c->comp('MyApp::Model::Something')->test;
  44
  45     print $c->comp('MyApp::Model::Something')->{foo};
  46
  47 =head1 DESCRIPTION
  48
  49 This is the universal base class for Catalyst components
  50 (Model/View/Controller).
  51
  52 It provides you with a generic new() for instantiation through Catalyst's
  53 component loader with config() support and a process() method placeholder.
  54
  55 =cut
  56
  57 __PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
  58
  59 around new => sub {
  60     my ( $orig, $self) = @_;
  61
  62     # Temporary fix, some components does not pass context to constructor
  63     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  64
  65     my $args =  $self->merge_config_hashes( $self->config, $arguments );
  66     $self->$orig( $args );
  67 };
  68
  69 no Moose;
  70
  71 sub COMPONENT {
  72     my ( $self, $c ) = @_;
  73
  74     # Temporary fix, some components does not pass context to constructor
  75     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  76     if( my $next = $self->next::can ){
  77       my $class = blessed $self || $self;
  78       my ($next_package) = Class::MOP::get_code_info($next);
  79       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}. This behavior is deprecated and will stop working in future releases.";
  80       return $next->($self, $arguments);
  81     }
  82     return $self->new($c, $arguments);
  83 }
  84
  85 sub config {
  86     my $self = shift;
  87     my $config_sub = $self->can('_config');
  88     my $config = $self->$config_sub() || {};
  89     if (@_) {
  90         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
  91         $self->_config(
  92             $self->merge_config_hashes( $config, $newconfig )
  93         );
  94     } else {
  95         # this is a bit of a kludge, required to make
  96         # __PACKAGE__->config->{foo} = 'bar';
  97         # work in a subclass. Calling the Class::Data::Inheritable setter
  98         # will create a new _config method in the current class if it's
  99         # currently inherited from the superclass. So, the can() call will
 100         # return a different subref in that case and that means we know to
 101         # copy and reset the value stored in the class data.
 102
 103         $self->_config( $config );
 104
 105         if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
 106
 107             $config = $self->merge_config_hashes( $config, {} );
 108             $self->$config_sub_now( $config );
 109         }
 110     }
 111     return $config;
 112 }
 113
 114 sub merge_config_hashes {
 115     my ( $self, $lefthash, $righthash ) = @_;
 116
 117     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 118 }
 119
 120 sub process {
 121
 122     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 123           . " did not override Catalyst::Component::process" );
 124 }
 125
 126 1;
 127
 128 __END__
 129
 130 =head1 METHODS
 131
 132 =head2 new($c, $arguments)
 133
 134 Called by COMPONENT to instantiate the component; should return an object
 135 to be stored in the application's component hash.
 136
 137 =head2 COMPONENT($c, $arguments)
 138
 139 If this method is present (as it is on all Catalyst::Component subclasses,
 140 it is called by Catalyst during setup_components with the application class
 141 as $c and any config entry on the application for this component (for example,
 142 in the case of MyApp::Controller::Foo this would be
 143 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 144 hashref and are merged with the __PACKAGE__->config hashref before calling
 145 ->new to instantiate the component.
 146
 147 =head2 $c->config
 148
 149 =head2 $c->config($hashref)
 150
 151 =head2 $c->config($key, $value, ...)
 152
 153 Accessor for this component's config hash. Config values can be set as
 154 key value pair, or you can specify a hashref. In either case the keys
 155 will be merged with any existing config settings. Each component in
 156 a Catalyst application has it's own config hash.
 157
 158 =head2 $c->process()
 159
 160 This is the default method called on a Catalyst component in the dispatcher.
 161 For instance, Views implement this action to render the response body
 162 when you forward to them. The default is an abstract method.
 163
 164 =head2 $c->merge_config_hashes( $hashref, $hashref )
 165
 166 Merges two hashes together recursively, giving right-hand precedence.
 167 Alias for the method in L<Catalyst::Utils>.
 168
 169 =head1 OPTIONAL METHODS
 170
 171 =head2 ACCEPT_CONTEXT($c, @args)
 172
 173 Catalyst components are normally initalized during server startup, either
 174 as a Class or a Instance. However, some components require information about
 175 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 176
 177 If this method is present, it is called during $c->comp/controller/model/view
 178 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 179 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 180 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 181 calling code in the application rather than the component itself.
 182
 183 =head1 SEE ALSO
 184
 185 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 186
 187 =head1 AUTHOR
 188
 189 Sebastian Riedel, C<sri@cpan.org>
 190 Marcus Ramberg, C<mramberg@cpan.org>
 191 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 192
 193 =head1 COPYRIGHT
 194
 195 This program is free software, you can redistribute it and/or modify it under
 196 the same terms as Perl itself.
 197
 198 =cut