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 qw/blessed/;
  11
  12 with 'MooseX::Emulate::Class::Accessor::Fast';
  13 with 'Catalyst::ClassData';
  14
  15
  16 =head1 NAME
  17
  18 Catalyst::Component - Catalyst Component Base Class
  19
  20 =head1 SYNOPSIS
  21
  22     # lib/MyApp/Model/Something.pm
  23     package MyApp::Model::Something;
  24
  25     use base 'Catalyst::Component';
  26
  27     __PACKAGE__->config( foo => 'bar' );
  28
  29     sub test {
  30         my $self = shift;
  31         return $self->{foo};
  32     }
  33
  34     sub forward_to_me {
  35         my ( $self, $c ) = @_;
  36         $c->response->output( $self->{foo} );
  37     }
  38
  39     1;
  40
  41     # Methods can be a request step
  42     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  43
  44     # Or just methods
  45     print $c->comp('MyApp::Model::Something')->test;
  46
  47     print $c->comp('MyApp::Model::Something')->{foo};
  48
  49 =head1 DESCRIPTION
  50
  51 This is the universal base class for Catalyst components
  52 (Model/View/Controller).
  53
  54 It provides you with a generic new() for instantiation through Catalyst's
  55 component loader with config() support and a process() method placeholder.
  56
  57 =cut
  58
  59 __PACKAGE__->mk_classdata('_plugins');
  60 __PACKAGE__->mk_classdata('_config');
  61
  62 sub BUILDARGS {
  63     my ($self) = @_;
  64
  65     # Temporary fix, some components does not pass context to constructor
  66     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  67
  68     my $args =  $self->merge_config_hashes( $self->config, $arguments );
  69
  70     return $args;
  71 }
  72
  73 sub COMPONENT {
  74     my ( $self, $c ) = @_;
  75
  76     # Temporary fix, some components does not pass context to constructor
  77     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  78     if( my $next = $self->next::can ){
  79       my $class = blessed $self || $self;
  80       my ($next_package) = Class::MOP::get_code_info($next);
  81       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n";
  82       warn "This behavior can no longer be supported, and so your application is probably broken.\n";
  83       warn "Your linearised isa hierarchy is: " . join(', ', mro::get_linear_isa($class)) . "\n";
  84       warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n";
  85     }
  86     return $self->new($c, $arguments);
  87 }
  88
  89 sub config {
  90     my $self = shift;
  91     my $config = $self->_config || {};
  92     if (@_) {
  93         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
  94         $self->_config(
  95             $self->merge_config_hashes( $config, $newconfig )
  96         );
  97     } else {
  98         # this is a bit of a kludge, required to make
  99         # __PACKAGE__->config->{foo} = 'bar';
 100         # work in a subclass. If we don't have the package symbol in the
 101         # current class we know we need to copy up to ours, which calling
 102         # the setter will do for us.
 103         my $class = blessed($self) || $self;
 104         my $meta = Class::MOP::get_metaclass_by_name($class);
 105         unless ($meta->has_package_symbol('$_config')) {
 106
 107             $config = $self->merge_config_hashes( $config, {} );
 108             $self->_config( $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 no Moose;
 127
 128 __PACKAGE__->meta->make_immutable;
 129 1;
 130
 131 __END__
 132
 133 =head1 METHODS
 134
 135 =head2 new($c, $arguments)
 136
 137 Called by COMPONENT to instantiate the component; should return an object
 138 to be stored in the application's component hash.
 139
 140 =head2 COMPONENT($c, $arguments)
 141
 142 If this method is present (as it is on all Catalyst::Component subclasses,
 143 it is called by Catalyst during setup_components with the application class
 144 as $c and any config entry on the application for this component (for example,
 145 in the case of MyApp::Controller::Foo this would be
 146 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 147 hashref and are merged with the __PACKAGE__->config hashref before calling
 148 ->new to instantiate the component.
 149
 150 =head2 $c->config
 151
 152 =head2 $c->config($hashref)
 153
 154 =head2 $c->config($key, $value, ...)
 155
 156 Accessor for this component's config hash. Config values can be set as
 157 key value pair, or you can specify a hashref. In either case the keys
 158 will be merged with any existing config settings. Each component in
 159 a Catalyst application has it's own config hash.
 160
 161 =head2 $c->process()
 162
 163 This is the default method called on a Catalyst component in the dispatcher.
 164 For instance, Views implement this action to render the response body
 165 when you forward to them. The default is an abstract method.
 166
 167 =head2 $c->merge_config_hashes( $hashref, $hashref )
 168
 169 Merges two hashes together recursively, giving right-hand precedence.
 170 Alias for the method in L<Catalyst::Utils>.
 171
 172 =head1 OPTIONAL METHODS
 173
 174 =head2 ACCEPT_CONTEXT($c, @args)
 175
 176 Catalyst components are normally initalized during server startup, either
 177 as a Class or a Instance. However, some components require information about
 178 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 179
 180 If this method is present, it is called during $c->comp/controller/model/view
 181 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 182 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 183 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 184 calling code in the application rather than the component itself.
 185
 186 =head1 SEE ALSO
 187
 188 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 189
 190 =head1 AUTHORS
 191
 192 Catalyst Contributors, see Catalyst.pm
 193
 194 =head1 COPYRIGHT
 195
 196 This program is free software, you can redistribute it and/or modify it under
 197 the same terms as Perl itself.
 198
 199 =cut