lib/Catalyst/Component.pm

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