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: "
135 . join( ",", @{ $config->{display_tables} } )
137 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 }
180 $self->{path} ||= "frontpage";
181 my @pi = split /\//, $self->{path};
182 shift @pi while @pi and !$pi[0];
183 $self->{table} = shift @pi;
184 $self->{action} = shift @pi;
185 $self->{args} = \@pi;
188 sub get_template_root { "." }
192 die "Do not use Maypole directly; use Apache::MVC or similar";
196 die "Do not use Maypole directly; use Apache::MVC or similar";
201 Maypole - MVC web application framework
205 See L<Maypole::Application>.
209 This documents the Maypole request object. For user documentation, see
216 Returns the L<Maypole::Config> object
220 My::App->setup($data_source, $user, $password, \%attr);
222 Initialise the maypole application and model classes. Your application should
223 call this after setting configuration via L<"config">
227 You should not call this directly, but you may wish to override this to
229 application-specific initialisation.
233 Get/set the Maypole::View object
237 sub My::App::debug {1}
239 Returns the debugging flag. Override this in your application class to
240 enable/disable debugging.
242 =head2 INSTANCE METHODS
244 =head3 parse_location
246 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a
248 request. It does this by setting the C<path>, and invoking C<parse_path>
252 You should only need to define this method if you are writing a new
258 Returns the request path
262 Parses the request path and sets the C<args>, C<action> and C<table>
267 The table part of the Maypole request path
271 The action part of the Maypole request path
275 A list of remaining parts of the request path after table and action
281 Turns post data and query string paramaters into a hash of C<params>.
283 You should only need to define this method if you are writing a new
289 Returns a hash of request parameters. The source of the parameters may
291 depending on the Maypole backend, but they are usually populated from
293 query string and POST data.
295 B<Note:> Where muliple values of a parameter were supplied, the
298 will be an array reference.
300 =head3 get_template_root
302 Implimentation-specific path to template root.
304 You should only need to define this method if you are writing a new
306 backend. Otherwise, see L<Maypole::Config/"template_root">
310 Returns a Maypole::Constant to indicate whether the request is valid.
312 The default implimentation checks that C<$r-E<gt>table> is publicly
314 and that the model class is configured to handle the C<$r-E<gt>action>
318 Returns a Maypole::Constant to indicate whether the user is
322 The default implimentation returns C<OK>
326 Returns the perl package name that will serve as the model for the
327 request. It corresponds to the request C<table> attribute.
329 =head3 additional_data
331 Called before the model processes the request, this method gives you a
333 to do some processing for each request, for example, manipulating
338 Get/set a list of model objects. The objects will be accessible in the
342 If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
344 it will be removed from C<args> and the retrieved object will be added
346 C<objects> list. See L<Maypole::Model> for more information.
350 $r->template_args->{foo} = 'bar';
352 Get/set a hash of template variables.
356 Get/set the template to be used by the view. By default, it returns
361 This method is called if any exceptions are raised during the
364 model/view processing. It should accept the exception as a parameter and
366 a Maypole::Constant to indicate whether the request should continue to
372 Get/set a request error
376 Get/set the response output. This is usually populated by the view
378 can skip view processing by setting the C<output>.
380 =head3 document_encoding
382 Get/set the output encoding. Default: utf-8.
386 Get/set the output content type. Default: text/html
390 Sends the output and additional headers to the user.
394 There's more documentation, examples, and a wiki at the Maypole web
397 http://maypole.perl.org/
399 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
403 Sebastian Riedel, c<sri@oook.de>
407 Simon Cozens, C<simon@cpan.org>
411 Danijel Milicevic, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
412 Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've
417 You may distribute this code under the same terms as Perl itself.