lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use strict;
   4 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
   5 use NEXT;
   6 use Catalyst::Utils;
   7
   8 BEGIN {
   9     if (eval 'require Moose; 1') {
  10         *__HAVE_MOOSE = sub () { 1 };
  11     }
  12     else {
  13         *__HAVE_MOOSE = sub () { 0 };
  14     }
  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($_) for qw/_config _plugins/;
  61
  62
  63
  64 sub new {
  65     my ( $class, $c ) = @_;
  66
  67     # Temporary fix, some components does not pass context to constructor
  68     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  69
  70     my $config = $class->merge_config_hashes( $class->config, $arguments );
  71
  72     my $self = $class->NEXT::new($config);
  73
  74     if (__HAVE_MOOSE) {
  75         my $meta = Class::MOP::get_metaclass_by_name($class);
  76         if ($meta) {
  77             $self = $meta->new_object(
  78                 __INSTANCE__ => $self,
  79                 %$config
  80             );
  81             # May not inherit from Moose::Object at all, so
  82             # call BUILDALL explicitly.
  83             $self->Moose::Object::BUILDALL($config);
  84         }
  85     }
  86     return $self;
  87 }
  88
  89 sub COMPONENT {
  90     my ( $self, $c ) = @_;
  91
  92     # Temporary fix, some components does not pass context to constructor
  93     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  94
  95     if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
  96         return $new;
  97     }
  98     else {
  99         if ( my $new = $self->new( $c, $arguments ) ) {
 100             return $new;
 101         }
 102         else {
 103             my $class = ref $self || $self;
 104             my $new   = $self->merge_config_hashes(
 105                 $self->config, $arguments );
 106             return bless $new, $class;
 107         }
 108     }
 109 }
 110
 111 sub config {
 112     my $self = shift;
 113     my $config_sub = $self->can('_config');
 114     my $config = $self->$config_sub() || {};
 115     if (@_) {
 116         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
 117         $self->_config(
 118             $self->merge_config_hashes( $config, $newconfig )
 119         );
 120     } else {
 121         # this is a bit of a kludge, required to make
 122         # __PACKAGE__->config->{foo} = 'bar';
 123         # work in a subclass. Calling the Class::Data::Inheritable setter
 124         # will create a new _config method in the current class if it's
 125         # currently inherited from the superclass. So, the can() call will
 126         # return a different subref in that case and that means we know to
 127         # copy and reset the value stored in the class data.
 128
 129         $self->_config( $config );
 130
 131         if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
 132
 133             $config = $self->merge_config_hashes( $config, {} );
 134             $self->$config_sub_now( $config );
 135         }
 136     }
 137     return $config;
 138 }
 139
 140 sub merge_config_hashes {
 141     my ( $self, $lefthash, $righthash ) = @_;
 142
 143     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 144 }
 145
 146 sub process {
 147
 148     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 149           . " did not override Catalyst::Component::process" );
 150 }
 151
 152 1;
 153
 154 __END__
 155
 156 =head1 METHODS
 157
 158 =head2 new($c, $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($c, $arguments)
 164
 165 If this method is present (as it is on all Catalyst::Component subclasses,
 166 it is called by Catalyst during setup_components with the application class
 167 as $c and any config entry on the application for this component (for example,
 168 in the case of MyApp::Controller::Foo this would be
 169 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 170 hashref and are merged with the __PACKAGE__->config hashref before calling
 171 ->new to instantiate the component.
 172
 173 =head2 $c->config
 174
 175 =head2 $c->config($hashref)
 176
 177 =head2 $c->config($key, $value, ...)
 178
 179 Accessor for this component's config hash. Config values can be set as
 180 key value pair, or you can specify a hashref. In either case the keys
 181 will be merged with any existing config settings. Each component in
 182 a Catalyst application has it's own config hash.
 183
 184 =head2 $c->process()
 185
 186 This is the default method called on a Catalyst component in the dispatcher.
 187 For instance, Views implement this action to render the response body
 188 when you forward to them. The default is an abstract method.
 189
 190 =head2 $c->merge_config_hashes( $hashref, $hashref )
 191
 192 Merges two hashes together recursively, giving right-hand precedence.
 193 Alias for the method in L<Catalyst::Utils>.
 194
 195 =head1 OPTIONAL METHODS
 196
 197 =head2 ACCEPT_CONTEXT($c, @args)
 198
 199 Catalyst components are normally initalized during server startup, either
 200 as a Class or a Instance. However, some components require information about
 201 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 202
 203 If this method is present, it is called during $c->comp/controller/model/view
 204 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 205 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 206 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 207 calling code in the application rather than the component itself.
 208
 209 =head1 SEE ALSO
 210
 211 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 212
 213 =head1 AUTHORS
 214
 215 Catalyst Contributors, see Catalyst.pm
 216
 217 =head1 COPYRIGHT
 218
 219 This program is free software, you can redistribute it and/or modify it under
 220 the same terms as Perl itself.
 221
 222 =cut