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/_attr_cache _action_cache _config/;
   8 __PACKAGE__->_attr_cache( {} );
   9 __PACKAGE__->_action_cache( [] );
  10
  11 # note - see attributes(3pm)
  12 sub MODIFY_CODE_ATTRIBUTES {
  13     my ( $class, $code, @attrs ) = @_;
  14     $class->_attr_cache->{$code} = [@attrs];
  15     push @{ $class->_action_cache }, [ $code, [@attrs] ];
  16     return ();
  17 }
  18
  19 sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[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
  73     # Temporary fix, some components does not pass context to constructor
  74     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
  75
  76     return $self->NEXT::new( { %{ $self->config }, %{ $arguments } } );
  77 }
  78
  79 # remember to leave blank lines between the consecutive =item's
  80 # otherwise the pod tools don't recognize the subsequent =items
  81
  82 =item $c->config
  83
  84 =item $c->config($hashref)
  85
  86 =item $c->config($key, $value, ...)
  87
  88 =cut
  89
  90 sub config {
  91     my $self = shift;
  92     $self->_config( {} ) unless $self->_config;
  93     if (@_) {
  94         my $config = @_ > 1 ? {@_} : $_[0];
  95         while ( my ( $key, $val ) = each %$config ) {
  96             $self->_config->{$key} = $val;
  97         }
  98     }
  99     return $self->_config;
 100 }
 101
 102 =item $c->process()
 103
 104 =cut
 105
 106 sub process {
 107     die( ( ref $_[0] || $_[0] ) . " did not override Catalyst::Base::process" );
 108 }
 109
 110 =item FETCH_CODE_ATTRIBUTES
 111
 112 =item MODIFY_CODE_ATTRIBUTES
 113
 114 =back
 115
 116 =head1 SEE ALSO
 117
 118 L<Catalyst>.
 119
 120 =head1 AUTHOR
 121
 122 Sebastian Riedel, C<sri@cpan.org>
 123 Marcus Ramberg, C<mramberg@cpan.org>
 124
 125 =head1 COPYRIGHT
 126
 127 This program is free software, you can redistribute it and/or modify it under
 128 the same terms as Perl itself.
 129
 130 =cut
 131
 132 1;