use NEXT;
use File::MMagic::XS qw(:compat);
-our $VERSION = '2.11';
+our $VERSION = '2.13';
our $mmagic = File::MMagic::XS->new();
# proposed privacy conventions:
# choose a frontend, initialise the config object, and load a plugin
use Maypole::Application qw/Relationship/;
+
+ # set everything up
+ __PACKAGE__->setup("dbi:SQLite:t/beerdb.db");
# get the empty config object created by Maypole::Application
my $config = __PACKAGE__->config;
date => [ qw/date/],
);
- # set everything up
- __PACKAGE__->setup("dbi:SQLite:t/beerdb.db");
+ # note : set up model before calling this method
+ BeerDB::Beer->required_columns([qw/name/]);
1;
Note that some details in some of these resources may be out of date.
-=over 4
+=over 4
=item The Maypole Manual
=item Web applications with Maypole
A tutorial written by Simon Cozens for YAPC::EU 2005 -
-http://www.droogs.org/perl/maypole/maypole-tutorial.pdf [228KB].
+http://www.aarontrevena.co.uk/opensource/maypole/maypole-tutorial.pdf [228KB].
=item A Database-Driven Web Application in 18 Lines of Code
=item Authentication
Some notes written by Simon Cozens. A little bit out of date, but still
-very useful: http://www.droogs.org/perl/maypole/authentication.html
+very useful: http://www.aarontrevena.co.uk/opensource/maypole/authentication.html
=item CheatSheet
=back
-=head1 DEMOS
-
-A couple of demos are available, sometimes with source code and configs.
-
-=over 4
-
-=item http://maypole.perl.org/beerdb/
-
-The standard BeerDB example, using the TT factory templates supplied in the
-distribution.
-
-=item beerdb.riverside-cms.co.uk
-
-The standard BeerDB example, running on Mason, using the factory templates
-supplied in the L<MasonX::Maypole> distribution.
-
-=item beerfb.riverside-cms.co.uk
-
-A demo of L<Maypole::FormBuilder>. This site is running on the set of Mason
-templates included in the L<Maypole::FormBuilder> distribution. See the
-synopsis of L<Maypole::Plugin::FormBuilder> for an example driver
-
-=back
-
=cut
__PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes_loaded);
__PACKAGE__->mk_accessors(
qw( params query objects model_class template_args output path
args action template error document_encoding content_type table
- headers_in headers_out stash status parent)
+ headers_in headers_out stash status parent build_form_elements
+ user session)
);
-__PACKAGE__->config( Maypole::Config->new() );
+__PACKAGE__->config( Maypole::Config->new({additional => { }, request_options => { }, view_options => { },}) );
__PACKAGE__->init_done(0);
=cut
-sub debug { 1 }
+sub debug { 0 }
=item config
Maypole::Model::CDBI is the base class.
My::App->setup($data_source, $user, $password,
- { opitons => { # These are DB connection options
+ { options => { # These are DB connection options
AutoCommit => 0,
RaiseError => 1,
...
# among other things, this populates $config->classes
$config->model->setup_database($config, $class, @_);
- foreach my $subclass ( @{ $config->classes } ) {
- next if $subclass->isa("Maypole::Model::Base");
- no strict 'refs';
- unshift @{ $subclass . "::ISA" }, $config->model;
- }
+ $config->model->add_model_superclass($config);
# Load custom model code, if it exists - nb this must happen after the
- # unshift, to allow code attributes to work, but before adopt(),
+ # adding the model superclass, to allow code attributes to work, but before adopt(),
# in case adopt() calls overridden methods on $subclass
foreach my $subclass ( @{ $config->classes } ) {
$class->load_model_subclass($subclass) unless ($class->model_classes_loaded());
sub new
{
my ($class) = @_;
-
my $self = bless {
- template_args => {},
config => $class->config,
}, $class;
-
+
+ $self->stash({});
+ $self->params({});
+ $self->query({});
+ $self->template_args({});
+ $self->args([]);
+ $self->objects([]);
return $self;
}
$self->status(Maypole::Constants::OK()); # set the default
$self->__call_hook('start_request_hook');
return $self->status unless $self->status == Maypole::Constants::OK();
-
die "status undefined after start_request_hook()" unless defined
$self->status;
-
- $self->get_session;
- $self->get_user;
-
- my $status = $self->handler_guts;
- return $status unless $status == OK;
+ my $session = $self->get_session;
+ $self->session($self->{session} || $session);
+ my $user = $self->get_user;
+ $self->user($self->{user} || $user);
+ my $status = $self->handler_guts;
+ return $status unless $status == OK;
# TODO: require send_output to return a status code
$self->send_output;
-
return $status;
}
which return fragments of HTML rather than entire pages, but once you've
done that, you can use the C<component> method of the Maypole request object
to call those actions. You may pass a query string in the usual URL style.
+
You should not fully qualify the Maypole URLs.
+Note: any HTTP POST or URL parameters passed to the parent are not passed to the
+component sub-request, only what is included in the url passed as an argument
+to the method
+
=cut
sub component {
my ( $r, $path ) = @_;
- my $self = bless { parent => $r }, ref $r;
+ my $self = bless { parent => $r, config => $r->{config}, } , ref $r;
+ $self->stash({});
+ $self->params({});
+ $self->query({});
+ $self->template_args({});
+ $self->args([]);
+ $self->objects([]);
+
+ $self->session($self->get_session);
+ $self->user($self->get_user);
+
my $url = URI->new($path);
$self->{path} = $url->path;
$self->parse_path;
$self->params( $url->query_form_hash );
- $self->query( $r->params );
$self->handler_guts;
return $self->output;
}
This is the main request handling method and calls various methods to handle the
request/response and defines the workflow within Maypole.
-B<Currently undocumented and liable to be refactored without warning>.
-
=cut
# The root of all evil
-sub handler_guts
-{
- my ($self) = @_;
-
- $self->__load_request_model;
+sub handler_guts {
+ my ($self) = @_;
+ $self->build_form_elements(1) unless (defined ($self->config->build_form_elements) && $self->config->build_form_elements == 0);
+ $self->__load_request_model;
- my $applicable = $self->is_model_applicable == OK;
+ my $applicable = $self->is_model_applicable == OK;
- my $status;
+ my $status;
- # handle authentication
- eval { $status = $self->call_authenticate };
- if ( my $error = $@ )
- {
- $status = $self->call_exception($error, "authentication");
- if ( $status != OK )
- {
- warn "caught authenticate error: $error";
- return $self->debug ?
- $self->view_object->error($self, $error) : ERROR;
- }
- }
- if ( $self->debug and $status != OK and $status != DECLINED )
- {
- $self->view_object->error( $self,
- "Got unexpected status $status from calling authentication" );
+ # handle authentication
+ eval { $status = $self->call_authenticate };
+ if ( my $error = $@ ) {
+ $status = $self->call_exception($error, "authentication");
+ if ( $status != OK ) {
+ $self->warn("caught authenticate error: $error");
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
}
+ }
+ if ( $self->debug and $status != OK and $status != DECLINED ) {
+ $self->view_object->error( $self,
+ "Got unexpected status $status from calling authentication" );
+ }
- return $status unless $status == OK;
+ return $status unless $status == OK;
- # We run additional_data for every request
- $self->additional_data;
+ # We run additional_data for every request
+ $self->additional_data;
- if ($applicable) {
+ # process request with model if applicable and template not set.
+ if ($applicable) {
+ unless ($self->{template}) {
eval { $self->model_class->process($self) };
- if ( my $error = $@ )
- {
- $status = $self->call_exception($error, "model");
- if ( $status != OK )
- {
- warn "caught model error: $error";
- return $self->debug ?
- $self->view_object->error($self, $error) : ERROR;
- }
- }
- } else {
- $self->__setup_plain_template;
+ if ( my $error = $@ ) {
+ $status = $self->call_exception($error, "model");
+ if ( $status != OK ) {
+ $self->warn("caught model error: $error");
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
+ }
+ }
}
+ } else {
+ $self->__setup_plain_template;
+ }
- # less frequent path - perhaps output has been set to an error message
- return OK if $self->output;
-
- # normal path - no output has been generated yet
- my $processed_view_ok = $self->__call_process_view;
-
+ # less frequent path - perhaps output has been set to an error message
+ if ($self->output) {
$self->{content_type} ||= $self->__get_mime_type();
$self->{document_encoding} ||= "utf-8";
+ return OK;
+ }
+ # normal path - no output has been generated yet
+ my $processed_view_ok = $self->__call_process_view;
- return $processed_view_ok;
+ $self->{content_type} ||= $self->__get_mime_type();
+ $self->{document_encoding} ||= "utf-8";
+
+ return $processed_view_ok;
}
my %filetypes = (
sub __get_mime_type {
my $self = shift;
my $type = 'text/html';
- if ($self->path =~ m/.*\.(\w{3,4})$/) {
+ if ($self->path =~ m/.*\.(\w{2,4})$/) {
$type = $filetypes{$1};
} else {
my $output = $self->output;
sub __load_request_model
{
my ($self) = @_;
- $self->model_class( $self->config->model->class_of($self, $self->table) );
+ # We may get a made up class from class_of
+ my $mclass = $self->config->model->class_of($self, $self->table);
+ if ( eval {$mclass->isa('Maypole::Model::Base')} ) {
+ $self->model_class( $mclass );
+ }
+ elsif ($self->debug > 1) {
+ $self->warn("***Warning: No $mclass class appropriate for model. @_");
+ }
}
+
# is_applicable() returned false, so set up a plain template. Model processing
# will be skipped, but need to remove the model anyway so the template can't
# access it.
my ($self) = @_;
# It's just a plain template
+ $self->build_form_elements(0);
$self->model_class(undef);
-
- my $path = $self->path;
- $path =~ s{/$}{}; # De-absolutify
- $self->path($path);
-
- $self->template($self->path);
+
+ unless ($self->template) {
+ # FIXME: this is likely to be redundant and is definately causing problems.
+ my $path = $self->path;
+ $path =~ s{/$}{}; # De-absolutify
+ $self->path($path);
+ $self->template($self->path);
+ }
}
# The model has been processed or skipped (if is_applicable returned false),
return $status;
}
+=item warn
+
+$r->warn('its all gone pete tong');
+
+Warn must be implemented by the backend, i.e. Apache::MVC
+and warn to stderr or appropriate logfile.
+
+You can also over-ride this in your Maypole driver, should you
+want to use something like Log::Log4perl instead.
+
+=cut
+
+sub warn { }
+
+=item build_form_elements
+
+$r->build_form_elements(0);
+
+Specify (in an action) whether to build HTML form elements and populate
+the cgi element of classmetadata in the view.
+
+You can set this globally using the accessor of the same name in Maypole::Config,
+this method allows you to over-ride that setting per action.
+
+=cut
+
=item get_request
You should only need to define this method if you are writing a new
if (not $ok)
{
- warn "We don't have that table ($table).\n"
+ $self->warn ("We don't have that table ($table).\n"
. "Available tables are: "
- . join( ",", keys %$ok_tables )
+ . join( ",", keys %$ok_tables ))
if $self->debug and not $ok_tables->{$table};
return DECLINED;
my $action = $self->action;
return OK if $self->model_class->is_public($action);
- warn "The action '$action' is not applicable to the table '$table'"
+ $self->warn("The action '$action' is not applicable to the table '$table'")
if $self->debug;
return DECLINED;
sub exception {
my ($self, $error, $when) = @_;
- if ($self->view_object->can("report_error") and $self->debug) {
+ if (ref $self->view_object && $self->view_object->can("report_error") and $self->debug) {
$self->view_object->report_error($self, $error, $when);
return OK;
}
}
-
-
=back
=head2 Path processing and manipulation
=cut
-sub parse_path
-{
+sub parse_path {
my ($self) = @_;
-
+
# Previous versions unconditionally set table, action and args to whatever
# was in @pi (or else to defaults, if @pi is empty).
# Adding preprocess_path(), and then setting table, action and args
# conditionally, broke lots of tests, hence this:
$self->$_(undef) for qw/action table args/;
-
$self->preprocess_path;
- $self->path || $self->path('frontpage');
- my @pi = grep {length} split '/', $self->path;
+ # use frontpage template for frontpage
+ unless ($self->path && $self->path ne '/') {
+ $self->path('frontpage');
+ }
+ my @pi = grep {length} split '/', $self->path;
$self->table || $self->table(shift @pi);
$self->action || $self->action( shift @pi or 'index' );
=item preprocess_path
Sometimes when you don't want to rewrite or over-ride parse_path but
-want to rewrite urls or extract data from them before it is parsed.
+want to rewrite urls or extract data from them before it is parsed,
+the preprocess_path/location methods allow you to munge paths and urls
+before maypole maps them to actions, classes, etc.
This method is called after parse_location has populated the request
information and before parse_path has populated the model and action
information, and is passed the request object.
You can set action, args or table in this method and parse_path will
-then leave those values in place or populate them if not present
+then leave those values in place or populate them based on the current
+value of the path attribute if they are not present.
=cut
sub preprocess_path { };
+=item preprocess_location
+
+This method is called at the start of parse_location, after the headers in, and allows you
+to rewrite the url used by maypole, or dynamically set configuration
+like the base_uri based on the hostname or path.
+
+=cut
+
+sub preprocess_location { };
+
=item make_path( %args or \%args or @args )
This is the counterpart to C<parse_path>. It generates a path to use
=cut
+
sub make_path
{
my $r = shift;
class, it will be removed from C<args> and the retrieved object will be added to
the C<objects> list. See L<Maypole::Model> for more information.
+
+=item object
+
+Alias to get/set the first/only model object. The object will be accessible
+in the view templates.
+
+When used to set the object, will overwrite the request objects
+with a single object.
+
+=cut
+
+sub object {
+ my ($r,$object) = @_;
+ $r->objects([$object]) if ($object);
+ return undef unless $r->objects();
+ return $r->objects->[0];
+}
+
=item template_args
$self->template_args->{foo} = 'bar';
Get/set a hash of template variables.
+Maypole reserved words for template variables will over-ride values in template_variables.
+
+Reserved words are : r, request, object, objects, base, config and errors, as well as the
+current class or object name.
+
=item stash
-A place to put custom application data. Not used by Maypole itself.
+A place to put custom application data. Not used by Maypole itself.
=item template
$self->params->{$key} = $new_val;
}
- return ref $val ? @$val : ($val) if wantarray;
+ return (ref $val eq 'ARRAY') ? @$val : ($val) if wantarray;
- return ref $val ? $val->[0] : $val;
+ return (ref $val eq 'ARRAY') ? $val->[0] : $val;
}
die "redirect_request is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
}
-=item redirect_internal_request
-
-=cut
-
-sub redirect_internal_request {
-
-}
+# =item redirect_internal_request
+#
+# =cut
+#
+# sub redirect_internal_request {
+#
+# }
=item make_random_id
projects / maypole.git / blobdiff