lib/Catalyst/Component.pm

   1 package Catalyst::Component;
   2
   3 use strict;
   4 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
   5 use NEXT;
   6
   7 __PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
   8
   9 =head1 NAME
  10
  11 Catalyst::Component - Catalyst Component Base Class
  12
  13 =head1 SYNOPSIS
  14
  15     # lib/MyApp/Model/Something.pm
  16     package MyApp::Model::Something;
  17
  18     use base 'Catalyst::Component';
  19
  20     __PACKAGE__->config( foo => 'bar' );
  21
  22     sub test {
  23         my $self = shift;
  24         return $self->{foo};
  25     }
  26
  27     sub forward_to_me {
  28         my ( $self, $c ) = @_;
  29         $c->response->output( $self->{foo} );
  30     }
  31
  32     1;
  33
  34     # Methods can be a request step
  35     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  36
  37     # Or just methods
  38     print $c->comp('MyApp::Model::Something')->test;
  39
  40     print $c->comp('MyApp::Model::Something')->{foo};
  41
  42 =head1 DESCRIPTION
  43
  44 This is the universal base class for Catalyst components
  45 (Model/View/Controller).
  46
  47 It provides you with a generic new() for instantiation through Catalyst's
  48 component loader with config() support and a process() method placeholder.
  49
  50 =head1 ACCEPT_CONTEXT
  51
  52 Catalyst components are normally initalized during server startup, either
  53 as a Class or a Instance. However, some compoents require information about
  54 the current request. To do so, they can implement an ACCEPT_CONTEXT method.
  55
  56 The ACCEPT_CONTEXT method is called on the component as initalized at startup,
  57 with the current $c object, and should return itself. It can do whatever it
  58 likes with $c, such as extracting a path to use in the component or something
  59 similar.
  60
  61 This call happens for every $c->comp/controller/model/view call.
  62
  63
  64 =head1 METHODS
  65
  66 =head2 new($c)
  67
  68 =cut
  69
  70 sub new {
  71     my ( $self, $c ) = @_;
  72
  73     # Temporary fix, some components does not pass context to constructor
  74     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  75
  76     return $self->NEXT::new( { %{ $self->config }, %{$arguments} } );
  77 }
  78
  79 =head2 COMPONENT($c)
  80
  81 =cut
  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     if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
  90         return $new;
  91     }
  92     else {
  93         if ( my $new = $self->new( $c, $arguments ) ) {
  94             return $new;
  95         }
  96         else {
  97             my $class = ref $self || $self;
  98             my $new = { %{ $self->config }, %{$arguments} };
  99             return bless $new, $class;
 100         }
 101     }
 102 }
 103
 104 # remember to leave blank lines between the consecutive =head2's
 105 # otherwise the pod tools don't recognize the subsequent =head2s
 106
 107 =head2 $c->config
 108
 109 =head2 $c->config($hashref)
 110
 111 =head2 $c->config($key, $value, ...)
 112
 113 =cut
 114
 115 sub config {
 116     my $self = shift;
 117     my $config = $self->_config;
 118     unless ($config) {
 119         $self->_config( $config = {} );
 120     }
 121     if (@_) {
 122         $config = { %{$config}, %{@_ > 1 ? {@_} : $_[0]} };
 123         $self->_config($config);
 124     }
 125     return $config;
 126 }
 127
 128 =head2 $c->process()
 129
 130 =cut
 131
 132 sub process {
 133
 134     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 135           . " did not override Catalyst::Component::process" );
 136 }
 137
 138 =head1 SEE ALSO
 139
 140 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
 141
 142 =head1 AUTHOR
 143
 144 Sebastian Riedel, C<sri@cpan.org>
 145 Marcus Ramberg, C<mramberg@cpan.org>
 146 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 147
 148 =head1 COPYRIGHT
 149
 150 This program is free software, you can redistribute it and/or modify it under
 151 the same terms as Perl itself.
 152
 153 =cut
 154
 155 1;