2 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
3 use UNIVERSAL::require;
7 use Maypole::Constants;
11 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
12 __PACKAGE__->mk_accessors(
13 qw( ar params query objects model_class template_args output path
14 args action template error document_encoding content_type table)
16 __PACKAGE__->config( Maypole::Config->new() );
17 __PACKAGE__->init_done(0);
22 my $calling_class = shift;
23 $calling_class = ref $calling_class if ref $calling_class;
28 *{ $calling_class . "::handler" } =
29 sub { Maypole::handler( $calling_class, @_ ) };
31 my $config = $calling_class->config;
32 $config->model || $config->model("Maypole::Model::CDBI");
33 $config->model->require;
34 die "Couldn't load the model class $config->model: $@" if $@;
35 $config->model->setup_database( $config, $calling_class, @_ );
36 for my $subclass ( @{ $config->classes } ) {
38 unshift @{ $subclass . "::ISA" }, $config->model;
39 $config->model->adopt($subclass)
40 if $config->model->can("adopt");
46 my $config = $class->config;
47 $config->view || $config->view("Maypole::View::TT");
48 $config->view->require;
49 die "Couldn't load the view class " . $config->view . ": $@" if $@;
50 $config->display_tables
51 || $config->display_tables( [ $class->config->tables ] );
52 $class->view_object( $class->config->view->new );
59 # See Maypole::Workflow before trying to understand this.
60 my ( $class, $req ) = @_;
61 $class->init unless $class->init_done;
62 my $r = bless { config => $class->config }, $class;
63 $r->get_request($req);
65 my $status = $r->handler_guts();
66 return $status unless $status == OK;
71 # The root of all evil
74 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
75 my $applicable = $r->is_applicable;
76 unless ( $applicable == OK ) {
78 # It's just a plain template
79 delete $r->{model_class};
80 $r->{path} =~ s{/$}{}; # De-absolutify
81 $r->template( $r->{path} );
84 # We authenticate every request, needed for proper session management
86 eval { $status = $r->call_authenticate };
87 warn "No return value from authenticate" unless $status;
88 if ( my $error = $@ ) {
89 $status = $r->call_exception($error);
90 if ( $status != OK ) {
91 warn "caught authenticate error: $error";
92 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
95 if ( $r->debug and $status != OK and $status != DECLINED ) {
96 $r->view_object->error( $r,
97 "Got unexpected status $status from calling authentication" );
99 return $status unless $status == OK;
101 # We run additional_data for every request
103 if ( $applicable == OK ) {
104 eval { $r->model_class->process($r) };
105 if ( my $error = $@ ) {
106 $status = $r->call_exception($error);
107 if ( $status != OK ) {
108 warn "caught model error: $error";
109 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
113 if ( !$r->{output} ) { # You might want to do it yourself
114 eval { $status = $r->view_object->process($r) };
115 if ( my $error = $@ ) {
116 $status = $r->call_exception($error);
117 if ( $status != OK ) {
118 warn "caught view error: $error" if $r->debug;
119 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
129 my $config = $self->config;
130 $config->ok_tables || $config->ok_tables( $config->display_tables );
131 $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
132 if ref $config->ok_tables eq "ARRAY";
133 warn "We don't have that table ($self->{table}).\n"
134 . "Available tables are: "
135 . join( ",", @{ $config->{display_tables} } )
137 and not $config->ok_tables->{ $self->{table} }
139 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
142 return DECLINED unless $self->model_class->is_public( $self->{action} );
146 sub call_authenticate {
149 # Check if we have a model class
150 if ( $self->{model_class} ) {
151 return $self->model_class->authenticate($self)
152 if $self->model_class->can("authenticate");
154 return $self->authenticate($self); # Interface consistency is a Good Thing
161 # Check if we have a model class
162 if ( $self->{model_class}
163 && $self->model_class->can('exception') )
165 my $status = $self->model_class->exception( $self, $error );
166 return $status if $status == OK;
168 return $self->exception($error);
171 sub additional_data { }
173 sub authenticate { return OK }
175 sub exception { return ERROR }
179 $self->{path} ||= "frontpage";
180 my @pi = split /\//, $self->{path};
181 shift @pi while @pi and !$pi[0];
182 $self->{table} = shift @pi;
183 $self->{action} = shift @pi;
184 $self->{args} = \@pi;
187 sub get_template_root { "." }
191 die "Do not use Maypole directly; use Apache::MVC or similar";
195 die "Do not use Maypole directly; use Apache::MVC or similar";
200 Maypole - MVC web application framework
204 See L<Maypole::Application>.
208 This documents the Maypole request object. For user documentation, see
215 Returns the L<Maypole::Config> object
219 My::App->setup($data_source, $user, $password, \%attr);
221 Initialise the maypole application and model classes. Your application should
222 call this after setting configuration via L<"config">
226 You should not call this directly, but you may wish to override this to
228 application-specific initialisation.
232 Get/set the Maypole::View object
236 sub My::App::debug {1}
238 Returns the debugging flag. Override this in your application class to
239 enable/disable debugging.
241 =head2 INSTANCE METHODS
243 =head3 parse_location
245 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
247 request. It does this by setting the C<path>, and invoking C<parse_path>
251 You should only need to define this method if you are writing a new
257 Returns the request path
261 Parses the request path and sets the C<args>, C<action> and C<table>
266 The table part of the Maypole request path
270 The action part of the Maypole request path
274 A list of remaining parts of the request path after table and action
280 Turns post data and query string paramaters into a hash of C<params>.
282 You should only need to define this method if you are writing a new
288 Returns a hash of request parameters. The source of the parameters may
290 depending on the Maypole backend, but they are usually populated from
292 query string and POST data.
294 B<Note:> Where muliple values of a parameter were supplied, the
297 will be an array reference.
299 =head3 get_template_root
301 Implimentation-specific path to template root.
303 You should only need to define this method if you are writing a new
305 backend. Otherwise, see L<Maypole::Config/"template_root">
309 You should only need to define this method if you are writing a new
310 Maypole backend. It should return something that looks like an Apache
311 or CGI request object, it defaults to blank.
316 Returns a Maypole::Constant to indicate whether the request is valid.
318 The default implimentation checks that C<$r-E<gt>table> is publicly
320 and that the model class is configured to handle the C<$r-E<gt>action>
324 Returns a Maypole::Constant to indicate whether the user is
328 The default implimentation returns C<OK>
332 Returns the perl package name that will serve as the model for the
333 request. It corresponds to the request C<table> attribute.
335 =head3 additional_data
337 Called before the model processes the request, this method gives you a
339 to do some processing for each request, for example, manipulating
344 Get/set a list of model objects. The objects will be accessible in the
348 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
350 it will be removed from C<args> and the retrieved object will be added
352 C<objects> list. See L<Maypole::Model> for more information.
356 $r->template_args->{foo} = 'bar';
358 Get/set a hash of template variables.
362 Get/set the template to be used by the view. By default, it returns
367 This method is called if any exceptions are raised during the
370 model/view processing. It should accept the exception as a parameter and
372 a Maypole::Constant to indicate whether the request should continue to
378 Get/set a request error
382 Get/set the response output. This is usually populated by the view
384 can skip view processing by setting the C<output>.
386 =head3 document_encoding
388 Get/set the output encoding. Default: utf-8.
392 Get/set the output content type. Default: text/html
396 Sends the output and additional headers to the user.
398 =head3 call_authenticate
400 This method first checks if the relevant model class
401 can authenticate the user, or falls back to the default
402 authenticate method of your Maypole application.
405 =head3 call_exception
407 This model is called to catch exceptions, first after authenticate
408 ,then after processing the model class, and finally to check for
409 exceptions from the view class.
411 This method first checks if the relevant model class
412 can handle exceptions the user, or falls back to the default
413 exception method of your Maypole application.
418 This method sets up the class if it's not done yet, sets some
419 defaults and leaves the dirty work to handler_guts.
423 This is the core of maypole. You don't want to know.
427 There's more documentation, examples, and a wiki at the Maypole web
430 http://maypole.perl.org/
432 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
436 Sebastian Riedel, c<sri@oook.de>
438 =head1 AUTHOR EMERITUS
440 Simon Cozens, C<simon@cpan.org>
444 Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
445 Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've
450 You may distribute this code under the same terms as Perl itself.