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