lib/Catalyst/Base.pm

   1 package Catalyst::Base;
   2
   3 use strict;
   4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
   5 use NEXT;
   6
   7 __PACKAGE__->mk_classdata($_) for qw/_cache _config/;
   8 __PACKAGE__->_cache( [] );
   9
  10 sub MODIFY_CODE_ATTRIBUTES {
  11     my ( $class, $code, @attrs ) = @_;
  12     push @{ $class->_cache }, [ $code, [@attrs] ];
  13     return ();
  14 }
  15
  16 =head1 NAME
  17
  18 Catalyst::Base - Catalyst Universal Base Class
  19
  20 =head1 SYNOPSIS
  21
  22     # lib/MyApp/Model/Something.pm
  23     package MyApp::Model::Something;
  24
  25     use base 'Catalyst::Base';
  26
  27     __PACKAGE__->config( foo => 'bar' );
  28
  29     sub test {
  30         my $self = shift;
  31         return $self->{foo};
  32     }
  33
  34     sub forward_to_me {
  35         my ( $self, $c ) = @_;
  36         $c->response->output( $self->{foo} );
  37     }
  38
  39     1;
  40
  41     # Methods can be a request step
  42     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  43     MyApp->action( 'index.html' => \&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 =head1 METHODS
  59
  60 =over 4
  61
  62 =item new($c)
  63
  64 =cut
  65
  66 sub new {
  67     my ( $self, $c ) = @_;
  68     return $self->NEXT::new( $self->config );
  69 }
  70
  71 # remember to leave blank lines between the consecutive =item's
  72 # otherwise the pod tools don't recognize the subsequent =items
  73
  74 =item $c->config
  75
  76 =item $c->config($hashref)
  77
  78 =item $c->config($key, $value, ...)
  79
  80 =cut
  81
  82 sub config {
  83     my $self = shift;
  84     $self->_config( {} ) unless $self->_config;
  85     if ( $_[0] ) {
  86         my $config = $_[1] ? {@_} : $_[0];
  87         while ( my ( $key, $val ) = each %$config ) {
  88             $self->_config->{$key} = $val;
  89         }
  90     }
  91     return $self->_config;
  92 }
  93
  94 =item $c->process()
  95
  96 =cut
  97
  98 sub process { 1 }
  99
 100 =back
 101
 102 =head1 SEE ALSO
 103
 104 L<Catalyst>.
 105
 106 =head1 AUTHOR
 107
 108 Sebastian Riedel, C<sri@cpan.org>
 109
 110 =head1 COPYRIGHT
 111
 112 This program is free software, you can redistribute it and/or modify it under
 113 the same terms as Perl itself.
 114
 115 =cut
 116
 117 1;