use Maypole::Headers;
use Maypole::Components;
use URI();
+use URI::QueryParam;
+use NEXT;
use File::MMagic::XS qw(:compat);
our $VERSION = '2.11';
__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)
+ headers_in headers_out stash status parent)
);
__PACKAGE__->config( Maypole::Config->new() );
=cut
-sub setup_model
-{
- my $class = shift;
-
- $class = ref $class if ref $class;
-
- my $config = $class->config;
-
- $config->model || $config->model('Maypole::Model::CDBI');
-
- $config->model->require or die sprintf
- "Couldn't load the model class %s: %s", $config->model, $@;
-
- # 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;
-
- # Load custom model code, if it exists - nb this must happen after the
- # unshift, to allow code attributes to work, but before adopt(),
- # in case adopt() calls overridden methods on $subclass
- $class->load_model_subclass($subclass) unless ($class->model_classes_loaded());
-
- $config->model->adopt($subclass) if $config->model->can("adopt");
- }
+sub setup_model {
+ my $class = shift;
+ $class = ref $class if ref $class;
+ my $config = $class->config;
+ $config->model || $config->model('Maypole::Model::CDBI');
+ $config->model->require or die sprintf
+ "Couldn't load the model class %s: %s", $config->model, $@;
+
+ # 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;
+ }
+
+ # Load custom model code, if it exists - nb this must happen after the
+ # unshift, 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());
+ $config->model->adopt($subclass) if $config->model->can("adopt");
+ }
+
}
=item load_model_subclass($subclass)
C<$subclass> package, if one exists. So if you make a customized C<BeerDB::Beer>
package, you don't need to explicitly load it.
-If, perhaps during development, you don't want to load up custom classes, you
+If automatic loading causes problems, Override load_model_subclass in your driver.
+
+sub load_model_subclass {};
+
+Or perhaps during development, if you don't want to load up custom classes, you
can override this method and load them manually.
=cut
-sub load_model_subclass
-{
- my ($class, $subclass) = @_;
-
- my $config = $class->config;
-
- # Load any external files for the model base class or subclasses
- # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
- # Maypole::Plugin::Loader and Class::DBI.
- if ( $subclass->require )
- {
- warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
- }
- else
- {
- (my $filename = $subclass) =~ s!::!/!g;
- die "Loading '$subclass' failed: $@\n"
- unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
- warn "No external module for '$subclass'"
- if $class->debug > 1;
- }
+sub load_model_subclass {
+ my ($class, $subclass) = @_;
+
+ my $config = $class->config;
+
+ # Load any external files for the model base class or subclasses
+ # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
+ # Maypole::Plugin::Loader and Class::DBI.
+ if ( $subclass->require ) {
+ warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
+ } else {
+ (my $filename = $subclass) =~ s!::!/!g;
+ die "Loading '$subclass' failed: $@\n"
+ unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
+ warn "No external module for '$subclass'"
+ if $class->debug > 1;
+ }
}
=item init
return $status;
}
+=back
+
+=head2 component
+
+ Run Maypole sub-requests as components using L<Maypole::Components>
+
+ [% request.component("/beer/view_as_component/20") %]
+
+ Allows you to integrate the results of a Maypole request into an existing
+request. You'll need to set up actions and templates
+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.
+
+=cut
+
sub component {
- my ($r,$path) = @_;
- my $component = Maypole::Components->new(@_);
- return $component->handler($path);
+ my ( $r, $path ) = @_;
+ my $self = bless { parent => $r }, ref $r;
+ 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;
+}
+
+sub get_template_root {
+ my $self = shift;
+ my $r = shift;
+ return $r->parent->get_template_root if $r->{parent};
+ return $self->NEXT::DISTINCT::get_template_root( $r, @_ );
}
+sub view_object {
+ my $self = shift;
+ my $r = shift;
+ return $r->parent->view_object if $r->{parent};
+ return $self->NEXT::DISTINCT::view_object( $r, @_ );
+}
# Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other
# plugins also get to call the hook, we can cycle through the application's
$self->__load_request_model;
- my $applicable = $self->is_model_applicable;
+ my $applicable = $self->is_model_applicable == OK;
$self->__setup_plain_template unless $applicable;
Returns a Maypole::Constant to indicate whether the request is valid.
+=cut
+
+sub is_applicable { return shift->is_model_applicable(@_); }
+
=item is_model_applicable
Returns true or false to indicate whether the request is valid.
=cut
-sub is_model_applicable
-{
+sub is_model_applicable {
my ($self) = @_;
-
- # cater for applications that are using obsolete version
- if ($self->can('is_applicable'))
- {
- warn "DEPRECATION WARNING: rewrite is_applicable to the interface ".
- "of Maypole::is_model_applicable\n";
- return $self->is_applicable == OK;
- }
# Establish which tables should be processed by the model
my $config = $self->config;
. join( ",", keys %$ok_tables )
if $self->debug and not $ok_tables->{$table};
- return 0;
+ return DECLINED;
}
# Is the action public?
my $action = $self->action;
- return 1 if $self->model_class->is_public($action);
+ return OK if $self->model_class->is_public($action);
warn "The action '$action' is not applicable to the table '$table'"
if $self->debug;
- return 0;
+ return DECLINED;
}
=item get_session
=cut
-sub get_template_root {'.'}
-
=back
=head2 Request properties
projects / maypole.git / blobdiff