lib/Catalyst/Base.pm

   1 package Catalyst::Base;
   2
   3 use strict;
   4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
   5 use Catalyst::Utils;
   6 use Catalyst::Exception;
   7 use NEXT;
   8
   9 # Some caches...
  10 __PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache _config/;
  11 __PACKAGE__->_attr_cache( {} );
  12 __PACKAGE__->_action_cache( [] );
  13
  14 # note - see attributes(3pm)
  15 sub MODIFY_CODE_ATTRIBUTES {
  16     my ( $class, $code, @attrs ) = @_;
  17     $class->_attr_cache->{$code} = [@attrs];
  18     push @{ $class->_action_cache }, [ $code, [@attrs] ];
  19     return ();
  20 }
  21
  22 sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }
  23
  24 =head1 NAME
  25
  26 Catalyst::Base - Catalyst Universal Base Class
  27
  28 =head1 SYNOPSIS
  29
  30     # lib/MyApp/Model/Something.pm
  31     package MyApp::Model::Something;
  32
  33     use base 'Catalyst::Base';
  34
  35     __PACKAGE__->config( foo => 'bar' );
  36
  37     sub test {
  38         my $self = shift;
  39         return $self->{foo};
  40     }
  41
  42     sub forward_to_me {
  43         my ( $self, $c ) = @_;
  44         $c->response->output( $self->{foo} );
  45     }
  46
  47     1;
  48
  49     # Methods can be a request step
  50     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  51
  52     # Or just methods
  53     print $c->comp('MyApp::Model::Something')->test;
  54
  55     print $c->comp('MyApp::Model::Something')->{foo};
  56
  57 =head1 DESCRIPTION
  58
  59 This is the universal base class for Catalyst components
  60 (Model/View/Controller).
  61
  62 It provides you with a generic new() for instantiation through Catalyst's
  63 component loader with config() support and a process() method placeholder.
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item new($c)
  70
  71 =cut
  72
  73 sub new {
  74     my ( $self, $c ) = @_;
  75
  76     # You'll find yourself naked and strung from a tree if you ever
  77     # remove this again, k? :)
  78     my $class     = ref $self || $self;
  79     my $appname   = Catalyst::Utils::class2appclass($class);
  80     my $suffix    = Catalyst::Utils::class2classsuffix($class);
  81     my $appconfig = {};
  82
  83     # Not catched, for compatibility with non Catalyst apps
  84     eval '$appconfig = $appname->config->{$suffix} || {}';
  85     my $config = { %{ $self->config }, %{$appconfig} };
  86
  87     # Temporary fix, some components does not pass context to constructor
  88     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  89
  90     return $self->NEXT::new( { %{$config}, %{$arguments} } );
  91 }
  92
  93 # remember to leave blank lines between the consecutive =item's
  94 # otherwise the pod tools don't recognize the subsequent =items
  95
  96 =item $c->config
  97
  98 =item $c->config($hashref)
  99
 100 =item $c->config($key, $value, ...)
 101
 102 =cut
 103
 104 sub config {
 105     my $self = shift;
 106     $self->_config( {} ) unless $self->_config;
 107     if (@_) {
 108         my $config = @_ > 1 ? {@_} : $_[0];
 109         while ( my ( $key, $val ) = each %$config ) {
 110             $self->_config->{$key} = $val;
 111         }
 112     }
 113     return $self->_config;
 114 }
 115
 116 =item $c->process()
 117
 118 =cut
 119
 120 sub process {
 121
 122     Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
 123           . " did not override Catalyst::Base::process" );
 124 }
 125
 126 =item FETCH_CODE_ATTRIBUTES
 127
 128 =item MODIFY_CODE_ATTRIBUTES
 129
 130 =back
 131
 132 =head1 SEE ALSO
 133
 134 L<Catalyst>.
 135
 136 =head1 AUTHOR
 137
 138 Sebastian Riedel, C<sri@cpan.org>
 139 Marcus Ramberg, C<mramberg@cpan.org>
 140
 141 =head1 COPYRIGHT
 142
 143 This program is free software, you can redistribute it and/or modify it under
 144 the same terms as Perl itself.
 145
 146 =cut
 147
 148 1;