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
17 __PACKAGE__->config( Maypole::Config->new() );
18 __PACKAGE__->init_done(0);
23 my $calling_class = shift;
24 $calling_class = ref $calling_class if ref $calling_class;
27 no warnings 'redefine';
30 *{ $calling_class . "::handler" } =
31 sub { Maypole::handler( $calling_class, @_ ) };
33 my $config = $calling_class->config;
34 $config->model || $config->model("Maypole::Model::CDBI");
35 $config->model->require;
36 die "Couldn't load the model class $config->model: $@" if $@;
37 $config->model->setup_database( $config, $calling_class, @_ );
38 for my $subclass ( @{ $config->classes } ) {
40 unshift @{ $subclass . "::ISA" }, $config->model;
41 $config->model->adopt($subclass)
42 if $config->model->can("adopt");
48 my $config = $class->config;
49 $config->view || $config->view("Maypole::View::TT");
50 $config->view->require;
51 die "Couldn't load the view class " . $config->view . ": $@" if $@;
52 $config->display_tables
53 || $config->display_tables( $class->config->tables );
54 $class->view_object( $class->config->view->new );
61 # See Maypole::Workflow before trying to understand this.
62 my ( $class, $req ) = @_;
63 $class->init unless $class->init_done;
64 my $r = bless { template_args => {}, config => $class->config }, $class;
65 $r->get_request($req);
67 my $status = $r->handler_guts();
68 return $status unless $status == OK;
73 # The root of all evil
76 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
78 my $applicable = $r->is_applicable;
79 unless ( $applicable == OK ) {
81 # It's just a plain template
82 delete $r->{model_class};
83 $r->{path} =~ s{/$}{}; # De-absolutify
84 $r->template( $r->{path} );
87 # We authenticate every request, needed for proper session management
89 eval { $status = $r->call_authenticate };
90 if ( my $error = $@ ) {
91 $status = $r->call_exception($error);
92 if ( $status != OK ) {
93 warn "caught authenticate error: $error";
94 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
97 if ( $r->debug and $status != OK and $status != DECLINED ) {
98 $r->view_object->error( $r,
99 "Got unexpected status $status from calling authentication" );
101 return $status unless $status == OK;
103 # We run additional_data for every request
105 if ( $applicable == OK ) {
106 eval { $r->model_class->process($r) };
107 if ( my $error = $@ ) {
108 $status = $r->call_exception($error);
109 if ( $status != OK ) {
110 warn "caught model error: $error";
111 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
115 if ( !$r->{output} ) { # You might want to do it yourself
116 eval { $status = $r->view_object->process($r) };
117 if ( my $error = $@ ) {
118 $status = $r->call_exception($error);
119 if ( $status != OK ) {
120 warn "caught view error: $error" if $r->debug;
121 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
131 my $config = $self->config;
132 $config->ok_tables || $config->ok_tables( $config->display_tables );
133 $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
134 if ref $config->ok_tables eq "ARRAY";
135 warn "We don't have that table ($self->{table}).\n"
136 . "Available tables are: "
137 . join( ",", @{ $config->{display_tables} } )
139 and not $config->ok_tables->{ $self->{table} }
141 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
144 return DECLINED unless $self->model_class->is_public( $self->{action} );
148 sub call_authenticate {
151 # Check if we have a model class
152 if ( $self->{model_class} ) {
153 return $self->model_class->authenticate($self)
154 if $self->model_class->can("authenticate");
156 return $self->authenticate($self); # Interface consistency is a Good Thing
163 # Check if we have a model class
164 if ( $self->{model_class}
165 && $self->model_class->can('exception') )
167 my $status = $self->model_class->exception( $self, $error );
168 return $status if $status == OK;
170 return $self->exception($error);
173 sub additional_data { }
175 sub authenticate { return OK }
177 sub exception { return ERROR }
181 $self->{path} ||= "frontpage";
182 my @pi = split /\//, $self->{path};
183 shift @pi while @pi and !$pi[0];
184 $self->{table} = shift @pi;
185 $self->{action} = shift @pi;
186 $self->{args} = \@pi;
189 sub get_template_root { "." }
193 die "Do not use Maypole directly; use Apache::MVC or similar";
197 die "Do not use Maypole directly; use Apache::MVC or similar";
202 Maypole - MVC web application framework
206 See L<Maypole::Application>.
210 This documents the Maypole request object. For user documentation, see
217 Returns the L<Maypole::Config> object
221 My::App->setup($data_source, $user, $password, \%attr);
223 Initialise the maypole application and model classes. Your application should
224 call this after setting configuration via L<"config">
228 You should not call this directly, but you may wish to override this to
230 application-specific initialisation.
234 Get/set the Maypole::View object
238 sub My::App::debug {1}
240 Returns the debugging flag. Override this in your application class to
241 enable/disable debugging.
243 =head2 INSTANCE METHODS
245 =head3 parse_location
247 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
249 request. It does this by setting the C<path>, and invoking C<parse_path>
253 You should only need to define this method if you are writing a new
259 Returns the request path
263 Parses the request path and sets the C<args>, C<action> and C<table>
268 The table part of the Maypole request path
272 The action part of the Maypole request path
276 A list of remaining parts of the request path after table and action
282 A hash containing extra headers to be set on a request.
286 Turns post data and query string paramaters into a hash of C<params>.
288 You should only need to define this method if you are writing a new
294 Returns a hash of request parameters. The source of the parameters may
296 depending on the Maypole backend, but they are usually populated from
298 query string and POST data.
300 B<Note:> Where muliple values of a parameter were supplied, the
303 will be an array reference.
305 =head3 get_template_root
307 Implimentation-specific path to template root.
309 You should only need to define this method if you are writing a new
311 backend. Otherwise, see L<Maypole::Config/"template_root">
315 You should only need to define this method if you are writing a new
316 Maypole backend. It should return something that looks like an Apache
317 or CGI request object, it defaults to blank.
322 Returns a Maypole::Constant to indicate whether the request is valid.
324 The default implimentation checks that C<$r-E<gt>table> is publicly
326 and that the model class is configured to handle the C<$r-E<gt>action>
330 Returns a Maypole::Constant to indicate whether the user is
334 The default implimentation returns C<OK>
338 Returns the perl package name that will serve as the model for the
339 request. It corresponds to the request C<table> attribute.
341 =head3 additional_data
343 Called before the model processes the request, this method gives you a
345 to do some processing for each request, for example, manipulating
350 Get/set a list of model objects. The objects will be accessible in the
354 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
356 it will be removed from C<args> and the retrieved object will be added
358 C<objects> list. See L<Maypole::Model> for more information.
362 $r->template_args->{foo} = 'bar';
364 Get/set a hash of template variables.
368 Get/set the template to be used by the view. By default, it returns
373 This method is called if any exceptions are raised during the
376 model/view processing. It should accept the exception as a parameter and
378 a Maypole::Constant to indicate whether the request should continue to
384 Get/set a request error
388 Get/set the response output. This is usually populated by the view
390 can skip view processing by setting the C<output>.
392 =head3 document_encoding
394 Get/set the output encoding. Default: utf-8.
398 Get/set the output content type. Default: text/html
402 Sends the output and additional headers to the user.
404 =head3 call_authenticate
406 This method first checks if the relevant model class
407 can authenticate the user, or falls back to the default
408 authenticate method of your Maypole application.
411 =head3 call_exception
413 This model is called to catch exceptions, first after authenticate
414 ,then after processing the model class, and finally to check for
415 exceptions from the view class.
417 This method first checks if the relevant model class
418 can handle exceptions the user, or falls back to the default
419 exception method of your Maypole application.
424 This method sets up the class if it's not done yet, sets some
425 defaults and leaves the dirty work to handler_guts.
429 This is the core of maypole. You don't want to know.
433 There's more documentation, examples, and a wiki at the Maypole web
436 http://maypole.perl.org/
438 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
442 Sebastian Riedel, c<sri@oook.de>
444 =head1 AUTHOR EMERITUS
446 Simon Cozens, C<simon@cpan.org>
450 Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
451 Mickael Joanne, Randal Schwartz, Simon Flack, Steve Simms, Veljko Vidovic
452 and all the others who've helped.
456 You may distribute this code under the same terms as Perl itself.