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