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('_plugins');
  58 __PACKAGE__->mk_classdata('_config');
  59
  60 around new => sub {
  61     my ( $orig, $self) = @_;
  62
  63     # Temporary fix, some components does not pass context to constructor
  64     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  65
  66     my $args =  $self->merge_config_hashes( $self->config, $arguments );
  67     $self->$orig( $args );
  68 };
  69
  70 no Moose;
  71
  72 sub COMPONENT {
  73     my ( $self, $c ) = @_;
  74
  75     # Temporary fix, some components does not pass context to constructor
  76     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  77     if( my $next = $self->next::can ){
  78       my $class = blessed $self || $self;
  79       my ($next_package) = Class::MOP::get_code_info($next);
  80       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}. This behavior is deprecated and will stop working in future releases.";
  81       return $next->($self, $arguments);
  82     }
  83     return $self->new($c, $arguments);
  84 }
  85
  86 sub config {
  87     my $self = shift;
  88     my $config = $self->_config || {};
  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. If we don't have the package symbol in the
  98         # current class we know we need to copy up to ours, which calling
  99         # the setter will do for us.
 100
 101         unless ($self->meta->has_package_symbol('$_config')) {
 102
 103             $config = $self->merge_config_hashes( $config, {} );
 104             $self->_config( $config );
 105         }
 106     }
 107     return $config;
 108 }
 109
 110 sub merge_config_hashes {
 111     my ( $self, $lefthash, $righthash ) = @_;
 112
 113     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 114 }
 115
 116 sub process {
 117
 118     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 119           . " did not override Catalyst::Component::process" );
 120 }
 121
 122
 123 __PACKAGE__->meta->make_immutable;
 124 1;
 125
 126 __END__
 127
 128 =head1 METHODS
 129
 130 =head2 new($c, $arguments)
 131
 132 Called by COMPONENT to instantiate the component; should return an object
 133 to be stored in the application's component hash.
 134
 135 =head2 COMPONENT($c, $arguments)
 136
 137 If this method is present (as it is on all Catalyst::Component subclasses,
 138 it is called by Catalyst during setup_components with the application class
 139 as $c and any config entry on the application for this component (for example,
 140 in the case of MyApp::Controller::Foo this would be
 141 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 142 hashref and are merged with the __PACKAGE__->config hashref before calling
 143 ->new to instantiate the component.
 144
 145 =head2 $c->config
 146
 147 =head2 $c->config($hashref)
 148
 149 =head2 $c->config($key, $value, ...)
 150
 151 Accessor for this component's config hash. Config values can be set as
 152 key value pair, or you can specify a hashref. In either case the keys
 153 will be merged with any existing config settings. Each component in
 154 a Catalyst application has it's own config hash.
 155
 156 =head2 $c->process()
 157
 158 This is the default method called on a Catalyst component in the dispatcher.
 159 For instance, Views implement this action to render the response body
 160 when you forward to them. The default is an abstract method.
 161
 162 =head2 $c->merge_config_hashes( $hashref, $hashref )
 163
 164 Merges two hashes together recursively, giving right-hand precedence.
 165 Alias for the method in L<Catalyst::Utils>.
 166
 167 =head1 OPTIONAL METHODS
 168
 169 =head2 ACCEPT_CONTEXT($c, @args)
 170
 171 Catalyst components are normally initalized during server startup, either
 172 as a Class or a Instance. However, some components require information about
 173 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 174
 175 If this method is present, it is called during $c->comp/controller/model/view
 176 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 177 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 178 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 179 calling code in the application rather than the component itself.
 180
 181 =head1 SEE ALSO
 182
 183 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 184
 185 =head1 AUTHOR
 186
 187 Sebastian Riedel, C<sri@cpan.org>
 188 Marcus Ramberg, C<mramberg@cpan.org>
 189 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 190
 191 =head1 COPYRIGHT
 192
 193 This program is free software, you can redistribute it and/or modify it under
 194 the same terms as Perl itself.
 195
 196 =cut