2 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
4 use UNIVERSAL::require;
9 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
10 __PACKAGE__->mk_accessors(
11 qw( ar params query objects model_class template_args output path
12 args action template error document_encoding content_type table)
14 __PACKAGE__->config( Maypole::Config->new() );
15 __PACKAGE__->init_done(0);
16 use Maypole::Constants;
21 my $calling_class = shift;
22 $calling_class = ref $calling_class if ref $calling_class;
27 *{ $calling_class . "::handler" } =
28 sub { Maypole::handler( $calling_class, @_ ) };
30 my $config = $calling_class->config;
31 $config->model || $config->model("Maypole::Model::CDBI");
32 $config->model->require;
33 die "Couldn't load the model class $config->model: $@" if $@;
34 $config->model->setup_database( $config, $calling_class, @_ );
35 for my $subclass ( @{ $config->classes } ) {
37 unshift @{ $subclass . "::ISA" }, $config->model;
38 $config->model->adopt($subclass)
39 if $config->model->can("adopt");
45 my $config = $class->config;
46 $config->view || $config->view("Maypole::View::TT");
47 $config->view->require;
48 die "Couldn't load the view class " . $config->view . ": $@" if $@;
49 $config->display_tables
50 || $config->display_tables( [ $class->config->tables ] );
51 $class->view_object( $class->config->view->new );
58 # See Maypole::Workflow before trying to understand this.
59 my ( $class, $req ) = @_;
60 $class->init unless $class->init_done;
61 my $r = bless { config => $class->config }, $class;
62 $r->get_request($req);
64 my $status = $r->handler_guts();
65 return $status unless $status == OK;
70 # The root of all evil
73 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
74 my $applicable = $r->is_applicable;
75 unless ( $applicable == OK ) {
77 # It's just a plain template
78 delete $r->{model_class};
79 $r->{path} =~ s{/$}{}; # De-absolutify
80 $r->template( $r->{path} );
83 # We authenticate every request, needed for proper session management
85 eval { $status = $r->call_authenticate };
86 if ( my $error = $@ ) {
87 $status = $r->call_exception($error);
88 if ( $status != OK ) {
89 warn "caught authenticate error: $error";
90 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
93 if ( $r->debug and $status != OK and $status != DECLINED ) {
94 $r->view_object->error( $r,
95 "Got unexpected status $status from calling authentication" );
97 return $status unless $status == OK;
99 # We run additional_data for every request
101 if ( $applicable == OK ) {
102 eval { $r->model_class->process($r) };
103 if ( my $error = $@ ) {
104 $status = $r->call_exception($error);
105 if ( $status != OK ) {
106 warn "caught model error: $error";
107 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
111 if ( !$r->{output} ) { # You might want to do it yourself
112 eval { $status = $r->view_object->process($r) };
113 if ( my $error = $@ ) {
114 $status = $r->call_exception($error);
115 if ( $status != OK ) {
116 warn "caught view error: $error" if $r->debug;
117 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
127 my $config = $self->config;
128 $config->ok_tables || $config->ok_tables( $config->display_tables );
129 $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
130 if ref $config->ok_tables eq "ARRAY";
131 warn "We don't have that table ($self->{table})"
133 and not $config->ok_tables->{ $self->{table} };
134 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
136 # Does the action method exist?
137 my $cv = $self->model_class->can( $self->{action} );
138 warn "We don't have that action ($self->{action})"
139 if $self->debug and not $cv;
140 return DECLINED() unless $cv;
143 $self->{method_attribs} = join " ", attributes::get($cv);
145 warn "$self->{action} not exported" if $self->debug;
147 } unless $self->{method_attribs} =~ /\bExported\b/i;
151 sub call_authenticate {
154 # Check if we have a model class
155 if ( $self->{model_class} ) {
156 return $self->model_class->authenticate($self)
157 if $self->model_class->can("authenticate");
159 return $self->authenticate($self); # Interface consistency is a Good Thing
166 # Check if we have a model class
167 if ( $self->{model_class}
168 && $self->model_class->can('exception') )
170 my $status = $self->model_class->exception( $self, $error );
171 return $status if $status == OK;
173 return $self->exception($error);
176 sub additional_data { }
178 sub authenticate { return OK }
180 sub exception { return ERROR }
184 $self->{path} ||= "frontpage";
185 my @pi = split /\//, $self->{path};
186 shift @pi while @pi and !$pi[0];
187 $self->{table} = shift @pi;
188 $self->{action} = shift @pi;
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
214 L<Maypole::Tutorial>.
220 Returns the L<Maypole::Config> object
226 Initialise the maypole application and model classes. Your
228 call this after setting configuration via L<"config">
232 You should not call this directly, but you may wish to override this to
234 application-specific initialisation.
238 Get/set the Maypole::View object
242 sub My::App::debug {1}
244 Returns the debugging flag. Override this in your application class
246 enable/disable debugging.
248 =head2 INSTANCE METHODS
250 =head3 parse_location
252 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
254 request. It does this by setting the C<path>, and invoking C<parse_path>
258 You should only need to define this method if you are writing a new
264 Returns the request path
268 Parses the request path and sets the C<args>, C<action> and C<table>
273 The table part of the Maypole request path
277 The action part of the Maypole request path
281 A list of remaining parts of the request path after table and action
287 Turns post data and query string paramaters into a hash of C<params>.
289 You should only need to define this method if you are writing a new
295 Returns a hash of request parameters. The source of the parameters may
297 depending on the Maypole backend, but they are usually populated from
299 query string and POST data.
301 B<Note:> Where muliple values of a parameter were supplied, the
304 will be an array reference.
306 =head3 get_template_root
308 Implimentation-specific path to template root.
310 You should only need to define this method if you are writing a new
312 backend. Otherwise, see L<Maypole::Config/"template_root">
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.
400 There's more documentation, examples, and a wiki at the Maypole web
403 http://maypole.perl.org/
405 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
409 Sebastian Riedel, c<sri@oook.de>
413 Simon Cozens, C<simon@cpan.org>
417 Danijel Milicevic, Jesse Scheidlower, Jody Belka, Marcus Ramberg,
418 Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've
423 You may distribute this code under the same terms as Perl itself.