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.
 101         my $class = blessed($self) || $self;
 102         my $meta = Class::MOP::get_metaclass_by_name($class);
 103         unless ($meta->has_package_symbol('$_config')) {
 104
 105             $config = $self->merge_config_hashes( $config, {} );
 106             $self->_config( $config );
 107         }
 108     }
 109     return $config;
 110 }
 111
 112 sub merge_config_hashes {
 113     my ( $self, $lefthash, $righthash ) = @_;
 114
 115     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 116 }
 117
 118 sub process {
 119
 120     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 121           . " did not override Catalyst::Component::process" );
 122 }
 123
 124 no Moose;
 125
 126 __PACKAGE__->meta->make_immutable;
 127 1;
 128
 129 __END__
 130
 131 =head1 METHODS
 132
 133 =head2 new($c, $arguments)
 134
 135 Called by COMPONENT to instantiate the component; should return an object
 136 to be stored in the application's component hash.
 137
 138 =head2 COMPONENT($c, $arguments)
 139
 140 If this method is present (as it is on all Catalyst::Component subclasses,
 141 it is called by Catalyst during setup_components with the application class
 142 as $c and any config entry on the application for this component (for example,
 143 in the case of MyApp::Controller::Foo this would be
 144 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 145 hashref and are merged with the __PACKAGE__->config hashref before calling
 146 ->new to instantiate the component.
 147
 148 =head2 $c->config
 149
 150 =head2 $c->config($hashref)
 151
 152 =head2 $c->config($key, $value, ...)
 153
 154 Accessor for this component's config hash. Config values can be set as
 155 key value pair, or you can specify a hashref. In either case the keys
 156 will be merged with any existing config settings. Each component in
 157 a Catalyst application has it's own config hash.
 158
 159 =head2 $c->process()
 160
 161 This is the default method called on a Catalyst component in the dispatcher.
 162 For instance, Views implement this action to render the response body
 163 when you forward to them. The default is an abstract method.
 164
 165 =head2 $c->merge_config_hashes( $hashref, $hashref )
 166
 167 Merges two hashes together recursively, giving right-hand precedence.
 168 Alias for the method in L<Catalyst::Utils>.
 169
 170 =head1 OPTIONAL METHODS
 171
 172 =head2 ACCEPT_CONTEXT($c, @args)
 173
 174 Catalyst components are normally initalized during server startup, either
 175 as a Class or a Instance. However, some components require information about
 176 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 177
 178 If this method is present, it is called during $c->comp/controller/model/view
 179 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 180 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 181 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 182 calling code in the application rather than the component itself.
 183
 184 =head1 SEE ALSO
 185
 186 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 187
 188 =head1 AUTHORS
 189
 190 Catalyst Contributors, see Catalyst.pm
 191
 192 =head1 COPYRIGHT
 193
 194 This program is free software, you can redistribute it and/or modify it under
 195 the same terms as Perl itself.
 196
 197 =cut