2 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
4 use UNIVERSAL::require;
8 use Maypole::Constants;
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)
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;
29 *{ $calling_class . "::handler" } =
30 sub { Maypole::handler( $calling_class, @_ ) };
32 my $config = $calling_class->config;
33 $config->model || $config->model("Maypole::Model::CDBI");
34 $config->model->require;
35 die "Couldn't load the model class $config->model: $@" if $@;
36 $config->model->setup_database( $config, $calling_class, @_ );
37 for my $subclass ( @{ $config->classes } ) {
39 unshift @{ $subclass . "::ISA" }, $config->model;
40 $config->model->adopt($subclass)
41 if $config->model->can("adopt");
47 my $config = $class->config;
48 $config->view || $config->view("Maypole::View::TT");
49 $config->view->require;
50 die "Couldn't load the view class " . $config->view . ": $@" if $@;
51 $config->display_tables
52 || $config->display_tables( [ $class->config->tables ] );
53 $class->view_object( $class->config->view->new );
60 # See Maypole::Workflow before trying to understand this.
61 my ( $class, $req ) = @_;
62 $class->init unless $class->init_done;
63 my $r = bless { config => $class->config }, $class;
64 $r->get_request($req);
66 my $status = $r->handler_guts();
67 return $status unless $status == OK;
72 # The root of all evil
75 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
76 my $applicable = $r->is_applicable;
77 unless ( $applicable == OK ) {
79 # It's just a plain template
80 delete $r->{model_class};
81 $r->{path} =~ s{/$}{}; # De-absolutify
82 $r->template( $r->{path} );
85 # We authenticate every request, needed for proper session management
87 eval { $status = $r->call_authenticate };
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: ".join (",", @{ $config->{display_tables} })
136 and not $config->ok_tables->{ $self->{table} };
137 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
140 return DECLINED unless $self->model_class->is_public( $self->{action} );
144 sub call_authenticate {
147 # Check if we have a model class
148 if ( $self->{model_class} ) {
149 return $self->model_class->authenticate($self)
150 if $self->model_class->can("authenticate");
152 return $self->authenticate($self); # Interface consistency is a Good Thing
159 # Check if we have a model class
160 if ( $self->{model_class}
161 && $self->model_class->can('exception') )
163 my $status = $self->model_class->exception( $self, $error );
164 return $status if $status == OK;
166 return $self->exception($error);
169 sub additional_data { }
171 sub authenticate { return OK }
173 sub exception { return ERROR }
177 $self->{path} ||= "frontpage";
178 my @pi = split /\//, $self->{path};
179 shift @pi while @pi and !$pi[0];
180 $self->{table} = shift @pi;
181 $self->{action} = shift @pi;
182 $self->{args} = \@pi;
185 sub get_template_root { "." }
189 die "Do not use Maypole directly; use Apache::MVC or similar";
193 die "Do not use Maypole directly; use Apache::MVC or similar";
198 Maypole - MVC web application framework
202 See L<Maypole::Application>.
206 This documents the Maypole request object. For user documentation, see
213 Returns the L<Maypole::Config> object
217 My::App->setup($data_source, $user, $password, \%attr);
219 Initialise the maypole application and model classes. Your application should
220 call this after setting configuration via L<"config">
224 You should not call this directly, but you may wish to override this to
226 application-specific initialisation.
230 Get/set the Maypole::View object
234 sub My::App::debug {1}
236 Returns the debugging flag. Override this in your application class to
237 enable/disable debugging.
239 =head2 INSTANCE METHODS
241 =head3 parse_location
243 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
245 request. It does this by setting the C<path>, and invoking C<parse_path>
249 You should only need to define this method if you are writing a new
255 Returns the request path
259 Parses the request path and sets the C<args>, C<action> and C<table>
264 The table part of the Maypole request path
268 The action part of the Maypole request path
272 A list of remaining parts of the request path after table and action
278 Turns post data and query string paramaters into a hash of C<params>.
280 You should only need to define this method if you are writing a new
286 Returns a hash of request parameters. The source of the parameters may
288 depending on the Maypole backend, but they are usually populated from
290 query string and POST data.
292 B<Note:> Where muliple values of a parameter were supplied, the
295 will be an array reference.
297 =head3 get_template_root
299 Implimentation-specific path to template root.
301 You should only need to define this method if you are writing a new
303 backend. Otherwise, see L<Maypole::Config/"template_root">
307 Returns a Maypole::Constant to indicate whether the request is valid.
309 The default implimentation checks that C<$r-E<gt>table> is publicly
311 and that the model class is configured to handle the C<$r-E<gt>action>
315 Returns a Maypole::Constant to indicate whether the user is
319 The default implimentation returns C<OK>
323 Returns the perl package name that will serve as the model for the
324 request. It corresponds to the request C<table> attribute.
326 =head3 additional_data
328 Called before the model processes the request, this method gives you a
330 to do some processing for each request, for example, manipulating
335 Get/set a list of model objects. The objects will be accessible in the
339 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
341 it will be removed from C<args> and the retrieved object will be added
343 C<objects> list. See L<Maypole::Model> for more information.
347 $r->template_args->{foo} = 'bar';
349 Get/set a hash of template variables.
353 Get/set the template to be used by the view. By default, it returns
358 This method is called if any exceptions are raised during the
361 model/view processing. It should accept the exception as a parameter and
363 a Maypole::Constant to indicate whether the request should continue to
369 Get/set a request error
373 Get/set the response output. This is usually populated by the view
375 can skip view processing by setting the C<output>.
377 =head3 document_encoding
379 Get/set the output encoding. Default: utf-8.
383 Get/set the output content type. Default: text/html
387 Sends the output and additional headers to the user.
391 There's more documentation, examples, and a wiki at the Maypole web
394 http://maypole.perl.org/
396 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
400 Sebastian Riedel, c<sri@oook.de>
404 Simon Cozens, C<simon@cpan.org>
408 Danijel Milicevic, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
409 Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've
414 You may distribute this code under the same terms as Perl itself.