lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use Class::C3;
   4 use Moose;
   5 use MooseX::Adopt::Class::Accessor::Fast;
   6 use Catalyst::Utils;
   7
   8
   9 with 'MooseX::Emulate::Class::Accessor::Fast';
  10 with 'Catalyst::ClassData';
  11
  12 no Moose;
  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 sub new {
  60     my ( $self, $c ) = @_;
  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->next::method( $args );
  67 }
  68
  69 sub COMPONENT {
  70     my ( $self, $c ) = @_;
  71
  72     # Temporary fix, some components does not pass context to constructor
  73     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  74
  75
  76     #this is not the EXACT logic we had before, since  the original tested
  77     #for a true value before returning meaning that a subsequent COMPONENT
  78     #call could return undef and that would trigger a try to new, which could
  79     #again return undef, which would lead to a straight bless of the args and
  80     #config. I did not mantain that behavior because it did not seemed sane
  81     # please rip me a new one if you have reason to believe i am being stupid
  82     # --groditi
  83     return $self->next::can ?
  84       $self->next::method($c, $arguments) : $self->new($c, $arguments);
  85 }
  86
  87 sub config {
  88     my $self = shift;
  89     my $config_sub = $self->can('_config');
  90     my $config = $self->$config_sub() || {};
  91     if (@_) {
  92         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
  93         $self->_config(
  94             $self->merge_config_hashes( $config, $newconfig )
  95         );
  96     } else {
  97         # this is a bit of a kludge, required to make
  98         # __PACKAGE__->config->{foo} = 'bar';
  99         # work in a subclass. Calling the Class::Data::Inheritable setter
 100         # will create a new _config method in the current class if it's
 101         # currently inherited from the superclass. So, the can() call will
 102         # return a different subref in that case and that means we know to
 103         # copy and reset the value stored in the class data.
 104
 105         $self->_config( $config );
 106
 107         if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
 108
 109             $config = $self->merge_config_hashes( $config, {} );
 110             $self->$config_sub_now( $config );
 111         }
 112     }
 113     return $config;
 114 }
 115
 116 sub merge_config_hashes {
 117     my ( $self, $lefthash, $righthash ) = @_;
 118
 119     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 120 }
 121
 122 sub process {
 123
 124     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 125           . " did not override Catalyst::Component::process" );
 126 }
 127
 128 1;
 129
 130 __END__
 131
 132 =head1 METHODS
 133
 134 =head2 new($c, $arguments)
 135
 136 Called by COMPONENT to instantiate the component; should return an object
 137 to be stored in the application's component hash.
 138
 139 =head2 COMPONENT($c, $arguments)
 140
 141 If this method is present (as it is on all Catalyst::Component subclasses,
 142 it is called by Catalyst during setup_components with the application class
 143 as $c and any config entry on the application for this component (for example,
 144 in the case of MyApp::Controller::Foo this would be
 145 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 146 hashref and are merged with the __PACKAGE__->config hashref before calling
 147 ->new to instantiate the component.
 148
 149 =head2 $c->config
 150
 151 =head2 $c->config($hashref)
 152
 153 =head2 $c->config($key, $value, ...)
 154
 155 Accessor for this component's config hash. Config values can be set as
 156 key value pair, or you can specify a hashref. In either case the keys
 157 will be merged with any existing config settings. Each component in
 158 a Catalyst application has it's own config hash.
 159
 160 =head2 $c->process()
 161
 162 This is the default method called on a Catalyst component in the dispatcher.
 163 For instance, Views implement this action to render the response body
 164 when you forward to them. The default is an abstract method.
 165
 166 =head2 $c->merge_config_hashes( $hashref, $hashref )
 167
 168 Merges two hashes together recursively, giving right-hand precedence.
 169 Alias for the method in L<Catalyst::Utils>.
 170
 171 =head1 OPTIONAL METHODS
 172
 173 =head2 ACCEPT_CONTEXT($c, @args)
 174
 175 Catalyst components are normally initalized during server startup, either
 176 as a Class or a Instance. However, some components require information about
 177 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 178
 179 If this method is present, it is called during $c->comp/controller/model/view
 180 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 181 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 182 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 183 calling code in the application rather than the component itself.
 184
 185 =head1 SEE ALSO
 186
 187 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 188
 189 =head1 AUTHOR
 190
 191 Sebastian Riedel, C<sri@cpan.org>
 192 Marcus Ramberg, C<mramberg@cpan.org>
 193 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 194
 195 =head1 COPYRIGHT
 196
 197 This program is free software, you can redistribute it and/or modify it under
 198 the same terms as Perl itself.
 199
 200 =cut