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 if ( my $error = $@ ) {
88 $status = $r->call_exception($error);
89 if ( $status != OK ) {
90 warn "caught authenticate error: $error";
91 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
94 if ( $r->debug and $status != OK and $status != DECLINED ) {
95 $r->view_object->error( $r,
96 "Got unexpected status $status from calling authentication" );
98 return $status unless $status == OK;
100 # We run additional_data for every request
102 if ( $applicable == OK ) {
103 eval { $r->model_class->process($r) };
104 if ( my $error = $@ ) {
105 $status = $r->call_exception($error);
106 if ( $status != OK ) {
107 warn "caught model error: $error";
108 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
112 if ( !$r->{output} ) { # You might want to do it yourself
113 eval { $status = $r->view_object->process($r) };
114 if ( my $error = $@ ) {
115 $status = $r->call_exception($error);
116 if ( $status != OK ) {
117 warn "caught view error: $error" if $r->debug;
118 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
128 my $config = $self->config;
129 $config->ok_tables || $config->ok_tables( $config->display_tables );
130 $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
131 if ref $config->ok_tables eq "ARRAY";
132 warn "We don't have that table ($self->{table}).\n"
133 . "Available tables are: "
134 . join( ",", @{ $config->{display_tables} } )
136 and not $config->ok_tables->{ $self->{table} }
138 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
141 return DECLINED unless $self->model_class->is_public( $self->{action} );
145 sub call_authenticate {
148 # Check if we have a model class
149 if ( $self->{model_class} ) {
150 return $self->model_class->authenticate($self)
151 if $self->model_class->can("authenticate");
153 return $self->authenticate($self); # Interface consistency is a Good Thing
160 # Check if we have a model class
161 if ( $self->{model_class}
162 && $self->model_class->can('exception') )
164 my $status = $self->model_class->exception( $self, $error );
165 return $status if $status == OK;
167 return $self->exception($error);
170 sub additional_data { }
172 sub authenticate { return OK }
174 sub exception { return ERROR }
178 $self->{path} ||= "frontpage";
179 my @pi = split /\//, $self->{path};
180 shift @pi while @pi and !$pi[0];
181 $self->{table} = shift @pi;
182 $self->{action} = shift @pi;
183 $self->{args} = \@pi;
186 sub get_template_root { "." }
190 die "Do not use Maypole directly; use Apache::MVC or similar";
194 die "Do not use Maypole directly; use Apache::MVC or similar";
199 Maypole - MVC web application framework
203 See L<Maypole::Application>.
207 This documents the Maypole request object. For user documentation, see
214 Returns the L<Maypole::Config> object
218 My::App->setup($data_source, $user, $password, \%attr);
220 Initialise the maypole application and model classes. Your application should
221 call this after setting configuration via L<"config">
225 You should not call this directly, but you may wish to override this to
227 application-specific initialisation.
231 Get/set the Maypole::View object
235 sub My::App::debug {1}
237 Returns the debugging flag. Override this in your application class to
238 enable/disable debugging.
240 =head2 INSTANCE METHODS
242 =head3 parse_location
244 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
246 request. It does this by setting the C<path>, and invoking C<parse_path>
250 You should only need to define this method if you are writing a new
256 Returns the request path
260 Parses the request path and sets the C<args>, C<action> and C<table>
265 The table part of the Maypole request path
269 The action part of the Maypole request path
273 A list of remaining parts of the request path after table and action
279 Turns post data and query string paramaters into a hash of C<params>.
281 You should only need to define this method if you are writing a new
287 Returns a hash of request parameters. The source of the parameters may
289 depending on the Maypole backend, but they are usually populated from
291 query string and POST data.
293 B<Note:> Where muliple values of a parameter were supplied, the
296 will be an array reference.
298 =head3 get_template_root
300 Implimentation-specific path to template root.
302 You should only need to define this method if you are writing a new
304 backend. Otherwise, see L<Maypole::Config/"template_root">
308 You should only need to define this method if you are writing a new
309 Maypole backend. It should return something that looks like an Apache
310 or CGI request object, it defaults to blank.
315 Returns a Maypole::Constant to indicate whether the request is valid.
317 The default implimentation checks that C<$r-E<gt>table> is publicly
319 and that the model class is configured to handle the C<$r-E<gt>action>
323 Returns a Maypole::Constant to indicate whether the user is
327 The default implimentation returns C<OK>
331 Returns the perl package name that will serve as the model for the
332 request. It corresponds to the request C<table> attribute.
334 =head3 additional_data
336 Called before the model processes the request, this method gives you a
338 to do some processing for each request, for example, manipulating
343 Get/set a list of model objects. The objects will be accessible in the
347 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
349 it will be removed from C<args> and the retrieved object will be added
351 C<objects> list. See L<Maypole::Model> for more information.
355 $r->template_args->{foo} = 'bar';
357 Get/set a hash of template variables.
361 Get/set the template to be used by the view. By default, it returns
366 This method is called if any exceptions are raised during the
369 model/view processing. It should accept the exception as a parameter and
371 a Maypole::Constant to indicate whether the request should continue to
377 Get/set a request error
381 Get/set the response output. This is usually populated by the view
383 can skip view processing by setting the C<output>.
385 =head3 document_encoding
387 Get/set the output encoding. Default: utf-8.
391 Get/set the output content type. Default: text/html
395 Sends the output and additional headers to the user.
397 =head3 call_authenticate
399 This method first checks if the relevant model class
400 can authenticate the user, or falls back to the default
401 authenticate method of your Maypole application.
404 =head3 call_exception
406 This model is called to catch exceptions, first after authenticate
407 ,then after processing the model class, and finally to check for
408 exceptions from the view class.
410 This method first checks if the relevant model class
411 can handle exceptions the user, or falls back to the default
412 exception method of your Maypole application.
417 This method sets up the class if it's not done yet, sets some
418 defaults and leaves the dirty work to handler_guts.
422 This is the core of maypole. You don't want to know.
426 There's more documentation, examples, and a wiki at the Maypole web
429 http://maypole.perl.org/
431 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
435 Sebastian Riedel, c<sri@oook.de>
437 =head1 AUTHOR EMERITUS
439 Simon Cozens, C<simon@cpan.org>
443 Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
444 Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've
449 You may distribute this code under the same terms as Perl itself.