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 # note - see attributes(3pm)
  11 sub MODIFY_CODE_ATTRIBUTES {
  12     my ( $class, $code, @attrs ) = @_;
  13     push @{ $class->_cache }, [ $code, [@attrs] ];
  14     return ();
  15 }
  16
  17 =head1 NAME
  18
  19 Catalyst::Base - Catalyst Universal Base Class
  20
  21 =head1 SYNOPSIS
  22
  23     # lib/MyApp/Model/Something.pm
  24     package MyApp::Model::Something;
  25
  26     use base 'Catalyst::Base';
  27
  28     __PACKAGE__->config( foo => 'bar' );
  29
  30     sub test {
  31         my $self = shift;
  32         return $self->{foo};
  33     }
  34
  35     sub forward_to_me {
  36         my ( $self, $c ) = @_;
  37         $c->response->output( $self->{foo} );
  38     }
  39
  40     1;
  41
  42     # Methods can be a request step
  43     $c->forward(qw/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 { die __PACKAGE__." did not override process."; }
  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 Marcus Ramberg, C<mramberg@cpan.org>
 110
 111 =head1 COPYRIGHT
 112
 113 This program is free software, you can redistribute it and/or modify it under
 114 the same terms as Perl itself.
 115
 116 =cut
 117
 118 1;