lib/Catalyst/Base.pm

   1 package Catalyst::Base;
   2
   3 use strict;
   4 use base qw/Catalyst::AttrContainer Class::Accessor::Fast/;
   5
   6 use Catalyst::Exception;
   7 use NEXT;
   8
   9 __PACKAGE__->mk_classdata($_) for qw/_config/;
  10
  11 sub _DISPATCH :Private {
  12     my ( $self, $c ) = @_;
  13     my @containers = $c->dispatcher->get_containers( $c->namespace );
  14     my %actions;
  15     foreach my $name (qw/begin auto end/) {
  16
  17         # Go down the container list representing each part of the
  18         # current namespace inheritance tree, grabbing the actions hash
  19         # of the ActionContainer object and looking for actions of the
  20         # appropriate name registered to the namespace
  21
  22         $actions{$name} = [
  23             map    { $_->{$name} }
  24               grep { exists $_->{$name} }
  25               map  { $_->actions } @containers
  26         ];
  27     }
  28
  29     # Errors break the normal flow and the end action is instantly run
  30     my $error = 0;
  31
  32     # Execute last begin
  33     $c->state(1);
  34     if ( my $begin = @{ $actions{begin} }[-1] ) {
  35         $begin->execute($c);
  36         $error++ if scalar @{ $c->error };
  37     }
  38
  39     # Execute the auto chain
  40     my $autorun = 0;
  41     for my $auto ( @{ $actions{auto} } ) {
  42         last if $error;
  43         $autorun++;
  44         $auto->execute($c);
  45         $error++ if scalar @{ $c->error };
  46         last unless $c->state;
  47     }
  48
  49     # Execute the action or last default
  50     my $mkay = $autorun ? $c->state ? 1 : 0 : 1;
  51     if ($mkay) {
  52         unless ($error) {
  53             $c->action->execute($c);
  54             $error++ if scalar @{ $c->error };
  55         }
  56     }
  57
  58     # Execute last end
  59     if ( my $end = @{ $actions{end} }[-1] ) {
  60         $end->execute($c);
  61     }
  62 }
  63
  64 =head1 NAME
  65
  66 Catalyst::Base - Catalyst Universal Base Class
  67
  68 =head1 SYNOPSIS
  69
  70     # lib/MyApp/Model/Something.pm
  71     package MyApp::Model::Something;
  72
  73     use base 'Catalyst::Base';
  74
  75     __PACKAGE__->config( foo => 'bar' );
  76
  77     sub test {
  78         my $self = shift;
  79         return $self->{foo};
  80     }
  81
  82     sub forward_to_me {
  83         my ( $self, $c ) = @_;
  84         $c->response->output( $self->{foo} );
  85     }
  86
  87     1;
  88
  89     # Methods can be a request step
  90     $c->forward(qw/MyApp::Model::Something forward_to_me/);
  91
  92     # Or just methods
  93     print $c->comp('MyApp::Model::Something')->test;
  94
  95     print $c->comp('MyApp::Model::Something')->{foo};
  96
  97 =head1 DESCRIPTION
  98
  99 This is the universal base class for Catalyst components
 100 (Model/View/Controller).
 101
 102 It provides you with a generic new() for instantiation through Catalyst's
 103 component loader with config() support and a process() method placeholder.
 104
 105 =head1 METHODS
 106
 107 =over 4
 108
 109 =item new($c)
 110
 111 =cut
 112
 113 sub new {
 114     my ( $self, $c ) = @_;
 115
 116     # Temporary fix, some components does not pass context to constructor
 117     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
 118
 119     return $self->NEXT::new( { %{ $self->config }, %{ $arguments } } );
 120 }
 121
 122 # remember to leave blank lines between the consecutive =item's
 123 # otherwise the pod tools don't recognize the subsequent =items
 124
 125 =item $c->config
 126
 127 =item $c->config($hashref)
 128
 129 =item $c->config($key, $value, ...)
 130
 131 =cut
 132
 133 sub config {
 134     my $self = shift;
 135     $self->_config( {} ) unless $self->_config;
 136     if (@_) {
 137         my $config = @_ > 1 ? {@_} : $_[0];
 138         while ( my ( $key, $val ) = each %$config ) {
 139             $self->_config->{$key} = $val;
 140         }
 141     }
 142     return $self->_config;
 143 }
 144
 145 =item $c->process()
 146
 147 =cut
 148
 149 sub process {
 150
 151     Catalyst::Exception->throw(
 152         message => ( ref $_[0] || $_[0] ) . " did not override Catalyst::Base::process"
 153     );
 154 }
 155
 156 =item FETCH_CODE_ATTRIBUTES
 157
 158 =item MODIFY_CODE_ATTRIBUTES
 159
 160 =back
 161
 162 =head1 SEE ALSO
 163
 164 L<Catalyst>.
 165
 166 =head1 AUTHOR
 167
 168 Sebastian Riedel, C<sri@cpan.org>
 169 Marcus Ramberg, C<mramberg@cpan.org>
 170 Matt S Trout, C<mst@shadowcatsystems.co.uk>
 171
 172 =head1 COPYRIGHT
 173
 174 This program is free software, you can redistribute it and/or modify it under
 175 the same terms as Perl itself.
 176
 177 =cut
 178
 179 1;