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