lib/Catalyst/Base.pm

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