2 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
3 use UNIVERSAL::require;
7 use Maypole::Constants;
10 our $VERSION = '2.05';
12 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
13 __PACKAGE__->mk_accessors(
14 qw( ar params query objects model_class template_args output path
15 args action template error document_encoding content_type table
16 headers_in headers_out )
18 __PACKAGE__->config( Maypole::Config->new() );
19 __PACKAGE__->init_done(0);
24 my $calling_class = shift;
25 $calling_class = ref $calling_class if ref $calling_class;
28 no warnings 'redefine';
31 *{ $calling_class . "::handler" } =
32 sub { Maypole::handler( $calling_class, @_ ) };
34 my $config = $calling_class->config;
35 $config->model || $config->model("Maypole::Model::CDBI");
36 $config->model->require;
37 die "Couldn't load the model class $config->model: $@" if $@;
38 $config->model->setup_database( $config, $calling_class, @_ );
39 for my $subclass ( @{ $config->classes } ) {
41 unshift @{ $subclass . "::ISA" }, $config->model;
42 $config->model->adopt($subclass)
43 if $config->model->can("adopt");
49 my $config = $class->config;
50 $config->view || $config->view("Maypole::View::TT");
51 $config->view->require;
52 die "Couldn't load the view class " . $config->view . ": $@" if $@;
53 $config->display_tables
54 || $config->display_tables( $class->config->tables );
55 $class->view_object( $class->config->view->new );
62 # See Maypole::Workflow before trying to understand this.
63 my ( $class, $req ) = @_;
64 $class->init unless $class->init_done;
65 my $r = bless { template_args => {}, config => $class->config }, $class;
66 $r->headers_out(Maypole::Headers->new);
67 $r->get_request($req);
69 my $status = $r->handler_guts();
70 return $status unless $status == OK;
75 # The root of all evil
78 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
80 my $applicable = $r->is_applicable;
81 unless ( $applicable == OK ) {
83 # It's just a plain template
84 delete $r->{model_class};
85 $r->{path} =~ s{/$}{}; # De-absolutify
86 $r->template( $r->{path} );
89 # We authenticate every request, needed for proper session management
91 eval { $status = $r->call_authenticate };
92 if ( my $error = $@ ) {
93 $status = $r->call_exception($error);
94 if ( $status != OK ) {
95 warn "caught authenticate error: $error";
96 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
99 if ( $r->debug and $status != OK and $status != DECLINED ) {
100 $r->view_object->error( $r,
101 "Got unexpected status $status from calling authentication" );
103 return $status unless $status == OK;
105 # We run additional_data for every request
107 if ( $applicable == OK ) {
108 eval { $r->model_class->process($r) };
109 if ( my $error = $@ ) {
110 $status = $r->call_exception($error);
111 if ( $status != OK ) {
112 warn "caught model error: $error";
113 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
117 if ( !$r->{output} ) { # You might want to do it yourself
118 eval { $status = $r->view_object->process($r) };
119 if ( my $error = $@ ) {
120 $status = $r->call_exception($error);
121 if ( $status != OK ) {
122 warn "caught view error: $error" if $r->debug;
123 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
133 my $config = $self->config;
134 $config->ok_tables || $config->ok_tables( $config->display_tables );
135 $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
136 if ref $config->ok_tables eq "ARRAY";
137 warn "We don't have that table ($self->{table}).\n"
138 . "Available tables are: "
139 . join( ",", @{ $config->{display_tables} } )
141 and not $config->ok_tables->{ $self->{table} }
143 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
146 return DECLINED unless $self->model_class->is_public( $self->{action} );
150 sub call_authenticate {
153 # Check if we have a model class
154 if ( $self->{model_class} ) {
155 return $self->model_class->authenticate($self)
156 if $self->model_class->can("authenticate");
158 return $self->authenticate($self); # Interface consistency is a Good Thing
165 # Check if we have a model class
166 if ( $self->{model_class}
167 && $self->model_class->can('exception') )
169 my $status = $self->model_class->exception( $self, $error );
170 return $status if $status == OK;
172 return $self->exception($error);
175 sub additional_data { }
177 sub authenticate { return OK }
179 sub exception { return ERROR }
183 $self->{path} ||= "frontpage";
184 my @pi = split /\//, $self->{path};
185 shift @pi while @pi and !$pi[0];
186 $self->{table} = shift @pi;
187 $self->{action} = shift @pi;
188 $self->{action} ||= "index";
189 $self->{args} = \@pi;
192 sub get_template_root { "." }
196 die "Do not use Maypole directly; use Apache::MVC or similar";
200 die "Do not use Maypole directly; use Apache::MVC or similar";
205 Maypole - MVC web application framework
209 See L<Maypole::Application>.
213 This documents the Maypole request object. For user documentation, see
220 Returns the L<Maypole::Config> object
224 My::App->setup($data_source, $user, $password, \%attr);
226 Initialise the maypole application and model classes. Your application should
227 call this after setting configuration via L<"config">
231 You should not call this directly, but you may wish to override this to
233 application-specific initialisation.
237 Get/set the Maypole::View object
241 sub My::App::debug {1}
243 Returns the debugging flag. Override this in your application class to
244 enable/disable debugging.
246 =head2 INSTANCE METHODS
248 =head3 parse_location
250 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
252 request. It does this by setting the C<path>, and invoking C<parse_path>
256 You should only need to define this method if you are writing a new
262 Returns the request path
266 Parses the request path and sets the C<args>, C<action> and C<table>
271 The table part of the Maypole request path
275 The action part of the Maypole request path
279 A list of remaining parts of the request path after table and action
285 A L<Maypole::Headers> object containing HTTP headers for the request
289 A L<HTTP::Headers> object that contains HTTP headers for the output
293 Turns post data and query string paramaters into a hash of C<params>.
295 You should only need to define this method if you are writing a new
301 Returns a hash of request parameters. The source of the parameters may
303 depending on the Maypole backend, but they are usually populated from
305 query string and POST data.
307 B<Note:> Where muliple values of a parameter were supplied, the
310 will be an array reference.
312 =head3 get_template_root
314 Implimentation-specific path to template root.
316 You should only need to define this method if you are writing a new
318 backend. Otherwise, see L<Maypole::Config/"template_root">
322 You should only need to define this method if you are writing a new
323 Maypole backend. It should return something that looks like an Apache
324 or CGI request object, it defaults to blank.
329 Returns a Maypole::Constant to indicate whether the request is valid.
331 The default implimentation checks that C<$r-E<gt>table> is publicly
333 and that the model class is configured to handle the C<$r-E<gt>action>
337 Returns a Maypole::Constant to indicate whether the user is
341 The default implimentation returns C<OK>
345 Returns the perl package name that will serve as the model for the
346 request. It corresponds to the request C<table> attribute.
348 =head3 additional_data
350 Called before the model processes the request, this method gives you a
352 to do some processing for each request, for example, manipulating
357 Get/set a list of model objects. The objects will be accessible in the
361 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
363 it will be removed from C<args> and the retrieved object will be added
365 C<objects> list. See L<Maypole::Model> for more information.
369 $r->template_args->{foo} = 'bar';
371 Get/set a hash of template variables.
375 Get/set the template to be used by the view. By default, it returns
380 This method is called if any exceptions are raised during the
383 model/view processing. It should accept the exception as a parameter and
385 a Maypole::Constant to indicate whether the request should continue to
391 Get/set a request error
395 Get/set the response output. This is usually populated by the view
397 can skip view processing by setting the C<output>.
399 =head3 document_encoding
401 Get/set the output encoding. Default: utf-8.
405 Get/set the output content type. Default: text/html
409 Sends the output and additional headers to the user.
411 =head3 call_authenticate
413 This method first checks if the relevant model class
414 can authenticate the user, or falls back to the default
415 authenticate method of your Maypole application.
418 =head3 call_exception
420 This model is called to catch exceptions, first after authenticate
421 ,then after processing the model class, and finally to check for
422 exceptions from the view class.
424 This method first checks if the relevant model class
425 can handle exceptions the user, or falls back to the default
426 exception method of your Maypole application.
431 This method sets up the class if it's not done yet, sets some
432 defaults and leaves the dirty work to handler_guts.
436 This is the core of maypole. You don't want to know.
440 There's more documentation, examples, and a wiki at the Maypole web
443 http://maypole.perl.org/
445 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
449 Sebastian Riedel, c<sri@oook.de>
451 =head1 AUTHOR EMERITUS
453 Simon Cozens, C<simon@cpan.org>
457 Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
458 Mickael Joanne, Randal Schwartz, Simon Flack, Steve Simms, Veljko Vidovic
459 and all the others who've helped.
463 You may distribute this code under the same terms as Perl itself.