lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use Moose;
   4 use MooseX::Adopt::Class::Accessor::Fast;
   5 use Catalyst::Utils;
   6
   7 with 'MooseX::Emulate::Class::Accessor::Fast';
   8 with 'Catalyst::ClassData';
   9
  10
  11 =head1 NAME
  12
  13 Catalyst::Component - Catalyst Component Base Class
  14
  15 =head1 SYNOPSIS
  16
  17     # lib/MyApp/Model/Something.pm
  18     package MyApp::Model::Something;
  19
  20     use base 'Catalyst::Component';
  21
  22     __PACKAGE__->config( foo => 'bar' );
  23
  24     sub test {
  25         my $self = shift;
  26         return $self->{foo};
  27     }
  28
  29     sub forward_to_me {
  30         my ( $self, $c ) = @_;
  31         $c->response->output( $self->{foo} );
  32     }
  33
  34     1;
  35
  36     # Methods can be a request step
  37     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  38
  39     # Or just methods
  40     print $c->comp('MyApp::Model::Something')->test;
  41
  42     print $c->comp('MyApp::Model::Something')->{foo};
  43
  44 =head1 DESCRIPTION
  45
  46 This is the universal base class for Catalyst components
  47 (Model/View/Controller).
  48
  49 It provides you with a generic new() for instantiation through Catalyst's
  50 component loader with config() support and a process() method placeholder.
  51
  52 =cut
  53
  54 __PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
  55
  56 around new => sub {
  57     my ( $orig, $self) = @_;
  58
  59     # Temporary fix, some components does not pass context to constructor
  60     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  61
  62     my $args =  $self->merge_config_hashes( $self->config, $arguments );
  63     $self->$orig( $args );
  64 };
  65
  66 no Moose;
  67
  68 sub COMPONENT {
  69     my ( $self, $c ) = @_;
  70
  71     # Temporary fix, some components does not pass context to constructor
  72     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  73     return $self->new($c, $arguments);
  74 }
  75
  76 sub config {
  77     my $self = shift;
  78     my $config_sub = $self->can('_config');
  79     my $config = $self->$config_sub() || {};
  80     if (@_) {
  81         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
  82         $self->_config(
  83             $self->merge_config_hashes( $config, $newconfig )
  84         );
  85     } else {
  86         # this is a bit of a kludge, required to make
  87         # __PACKAGE__->config->{foo} = 'bar';
  88         # work in a subclass. Calling the Class::Data::Inheritable setter
  89         # will create a new _config method in the current class if it's
  90         # currently inherited from the superclass. So, the can() call will
  91         # return a different subref in that case and that means we know to
  92         # copy and reset the value stored in the class data.
  93
  94         $self->_config( $config );
  95
  96         if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
  97
  98             $config = $self->merge_config_hashes( $config, {} );
  99             $self->$config_sub_now( $config );
 100         }
 101     }
 102     return $config;
 103 }
 104
 105 sub merge_config_hashes {
 106     my ( $self, $lefthash, $righthash ) = @_;
 107
 108     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
 109 }
 110
 111 sub process {
 112
 113     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 114           . " did not override Catalyst::Component::process" );
 115 }
 116
 117 1;
 118
 119 __END__
 120
 121 =head1 METHODS
 122
 123 =head2 new($c, $arguments)
 124
 125 Called by COMPONENT to instantiate the component; should return an object
 126 to be stored in the application's component hash.
 127
 128 =head2 COMPONENT($c, $arguments)
 129
 130 If this method is present (as it is on all Catalyst::Component subclasses,
 131 it is called by Catalyst during setup_components with the application class
 132 as $c and any config entry on the application for this component (for example,
 133 in the case of MyApp::Controller::Foo this would be
 134 MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
 135 hashref and are merged with the __PACKAGE__->config hashref before calling
 136 ->new to instantiate the component.
 137
 138 =head2 $c->config
 139
 140 =head2 $c->config($hashref)
 141
 142 =head2 $c->config($key, $value, ...)
 143
 144 Accessor for this component's config hash. Config values can be set as
 145 key value pair, or you can specify a hashref. In either case the keys
 146 will be merged with any existing config settings. Each component in
 147 a Catalyst application has it's own config hash.
 148
 149 =head2 $c->process()
 150
 151 This is the default method called on a Catalyst component in the dispatcher.
 152 For instance, Views implement this action to render the response body
 153 when you forward to them. The default is an abstract method.
 154
 155 =head2 $c->merge_config_hashes( $hashref, $hashref )
 156
 157 Merges two hashes together recursively, giving right-hand precedence.
 158 Alias for the method in L<Catalyst::Utils>.
 159
 160 =head1 OPTIONAL METHODS
 161
 162 =head2 ACCEPT_CONTEXT($c, @args)
 163
 164 Catalyst components are normally initalized during server startup, either
 165 as a Class or a Instance. However, some components require information about
 166 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
 167
 168 If this method is present, it is called during $c->comp/controller/model/view
 169 with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
 170 would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
 171 ($c, 'bar', 'baz')) and the return value of this method is returned to the
 172 calling code in the application rather than the component itself.
 173
 174 =head1 SEE ALSO
 175
 176 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 177
 178 =head1 AUTHOR
 179
 180 Sebastian Riedel, C<sri@cpan.org>
 181 Marcus Ramberg, C<mramberg@cpan.org>
 182 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 183
 184 =head1 COPYRIGHT
 185
 186 This program is free software, you can redistribute it and/or modify it under
 187 the same terms as Perl itself.
 188
 189 =cut