lib/Catalyst/Component.pm

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