File Coverage

blib/lib/Catalyst/Component.pm
Criterion Covered Total %
statement 31 36 86.1
branch 9 14 64.3
condition 0 6 0.0
subroutine 8 9 88.9
pod 5 5 100.0
total 53 70 75.7


line stmt bran cond sub pod time code
1             package Catalyst::Component;
2              
3 57     57   775 use strict;
  57         526  
  57         875  
4 57     57   922 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
  57         542  
  57         1834  
5 57     57   2173 use NEXT;
  57         655  
  57         1692  
6 57     57   1660 use Catalyst::Utils;
  57         570  
  57         1288  
7              
8              
9             =head1 NAME
10            
11             Catalyst::Component - Catalyst Component Base Class
12            
13             =head1 SYNOPSIS
14            
15             # lib/MyApp/Model/Something.pm
16             package MyApp::Model::Something;
17            
18             use base 'Catalyst::Component';
19            
20             __PACKAGE__->config( foo => 'bar' );
21            
22             sub test {
23             my $self = shift;
24             return $self->{foo};
25             }
26            
27             sub forward_to_me {
28             my ( $self, $c ) = @_;
29             $c->response->output( $self->{foo} );
30             }
31            
32             1;
33            
34             # Methods can be a request step
35             $c->forward(qw/MyApp::Model::Something forward_to_me/);
36            
37             # Or just methods
38             print $c->comp('MyApp::Model::Something')->test;
39            
40             print $c->comp('MyApp::Model::Something')->{foo};
41            
42             =head1 DESCRIPTION
43            
44             This is the universal base class for Catalyst components
45             (Model/View/Controller).
46            
47             It provides you with a generic new() for instantiation through Catalyst's
48             component loader with config() support and a process() method placeholder.
49            
50             =cut
51              
52             __PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
53              
54              
55              
56             sub new {
57 3480     3480 1 72051     my ( $self, $c ) = @_;
58              
59             # Temporary fix, some components does not pass context to constructor
60 3480 50       53674     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
61              
62 3480         112506     return $self->NEXT::new(
63             $self->merge_config_hashes( $self->config, $arguments ) );
64             }
65              
66             sub COMPONENT {
67 2660     2660 1 37332     my ( $self, $c ) = @_;
68              
69             # Temporary fix, some components does not pass context to constructor
70 2660 50       51922     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
71              
72 2660 50       72962     if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
73 0         0         return $new;
74                 }
75                 else {
76 2660 50       108522         if ( my $new = $self->new( $c, $arguments ) ) {
77 2660         48626             return $new;
78                     }
79                     else {
80 0   0     0             my $class = ref $self || $self;
81 0         0             my $new = $self->merge_config_hashes(
82             $self->config, $arguments );
83 0         0             return bless $new, $class;
84                     }
85                 }
86             }
87              
88             sub config {
89 17917     17917 1 272234     my $self = shift;
90 17917         1204001     my $config = $self->_config;
91 17917 100       891250     unless ($config) {
92 1592         39910         $self->_config( $config = {} );
93                 }
94 17917 100       304488     if (@_) {
95 187 50       1892         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
  187         6933  
96 187         4759         $self->_config(
97                         $self->merge_config_hashes( $config, $newconfig )
98                     );
99                 }
100 17917         493931     return $config;
101             }
102              
103             sub merge_config_hashes {
104 3674     3674 1 46868     my ( $self, $lefthash, $righthash ) = @_;
105              
106 3674         57018     return Catalyst::Utils::merge_hashes( $lefthash, $righthash );
107             }
108              
109             sub process {
110              
111 0   0 0 1       Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] )
112                       . " did not override Catalyst::Component::process" );
113             }
114              
115             1;
116              
117             __END__
118            
119             =head1 METHODS
120            
121             =head2 new($c, $arguments)
122            
123             Called by COMPONENT to instantiate the component; should return an object
124             to be stored in the application's component hash.
125            
126             =head2 COMPONENT($c, $arguments)
127            
128             If this method is present (as it is on all Catalyst::Component subclasses,
129             it is called by Catalyst during setup_components with the application class
130             as $c and any config entry on the application for this component (for example,
131             in the case of MyApp::Controller::Foo this would be
132             MyApp->config->{'Controller::Foo'}). The arguments are expected to be a
133             hashref and are merged with the __PACKAGE__->config hashref before calling
134             ->new to instantiate the component.
135            
136             =head2 $c->config
137            
138             =head2 $c->config($hashref)
139            
140             =head2 $c->config($key, $value, ...)
141            
142             Accessor for this component's config hash. Config values can be set as
143             key value pair, or you can specify a hashref. In either case the keys
144             will be merged with any existing config settings. Each component in
145             a Catalyst application has it's own config hash.
146            
147             =head2 $c->process()
148            
149             This is the default method called on a Catalyst component in the dispatcher.
150             For instance, Views implement this action to render the response body
151             when you forward to them. The default is an abstract method.
152            
153             =head2 $c->merge_config_hashes( $hashref, $hashref )
154            
155             Merges two hashes together recursively, giving right-hand precedence.
156             Alias for the method in L<Catalyst::Utils>.
157            
158             =head1 OPTIONAL METHODS
159            
160             =head2 ACCEPT_CONTEXT($c, @args)
161            
162             Catalyst components are normally initalized during server startup, either
163             as a Class or a Instance. However, some components require information about
164             the current request. To do so, they can implement an ACCEPT_CONTEXT method.
165            
166             If this method is present, it is called during $c->comp/controller/model/view
167             with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/)
168             would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with
169             ($c, 'bar', 'baz')) and the return value of this method is returned to the
170             calling code in the application rather than the component itself.
171            
172             =head1 SEE ALSO
173            
174             L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
175            
176             =head1 AUTHOR
177            
178             Sebastian Riedel, C<sri@cpan.org>
179             Marcus Ramberg, C<mramberg@cpan.org>
180             Matt S Trout, C<mst@shadowcatsystems.co.uk>
181            
182             =head1 COPYRIGHT
183            
184             This program is free software, you can redistribute it and/or modify it under
185             the same terms as Perl itself.
186            
187             =cut