X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=4633b1f2a508f114d528d1eb03db3b65dedaa4cb;hb=a183ff6bda2ae98ef8f4a4f979647052e0020dea;hp=3fcfd159a835442d78ec806fdb1c948765e25efd;hpb=5a2a936da63a8463429f3cd486104d5410e73c04;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 3fcfd15..4633b1f 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -6,8 +6,9 @@ use warnings; use Maypole::Config; use Maypole::Constants; use Maypole::Headers; -use Maypole::Components; use URI(); +use URI::QueryParam; +use NEXT; use File::MMagic::XS qw(:compat); our $VERSION = '2.11'; @@ -202,7 +203,7 @@ __PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes __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() ); @@ -253,7 +254,7 @@ Some packages respond to higher debug levels, try increasing it to 2 or 3. =cut -sub debug { 0 } +sub debug { 0 } =item config @@ -261,20 +262,34 @@ Returns the L object =item setup - My::App->setup($data_source, $user, $password, \%attr); - -Initialise the Maypole application and plugins and model classes - see -L. - -If your model is based on L, the C<\%attr> hashref can -contain options that are passed directly to L, to control -how the model hierarchy is constructed. + My::App->setup($data_source, $user, $password, \%attr); +Initialise the Maypole application and plugins and model classes. Your application should call this B setting up configuration data via L<"config">. +It calls the hook C to setup the model. The %attr hash contains +options and arguments used to set up the model. See the particular model's +documentation. However here is the most usage of setup where +Maypole::Model::CDBI is the base class. + + My::App->setup($data_source, $user, $password, + { opitons => { # These are DB connection options + AutoCommit => 0, + RaiseError => 1, + ... + }, + # These are Class::DBI::Loader arguments. + relationships => 1, + ... + } + ); + +Also, see L. + =cut + sub setup { my $class = shift; @@ -293,35 +308,31 @@ don't need to load them in the driver. =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) @@ -330,32 +341,32 @@ This method is called from C. It attempts to load the C<$subclass> package, if one exists. So if you make a customized C 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 @@ -456,12 +467,46 @@ sub handler : method { return $status; } +=item component + + Run Maypole sub-requests as a component of the request + + [% 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 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 @@ -512,7 +557,7 @@ sub handler_guts $self->__load_request_model; - my $applicable = $self->is_model_applicable; + my $applicable = $self->is_model_applicable == OK; $self->__setup_plain_template unless $applicable; @@ -716,6 +761,10 @@ from a Maypole:Constant to a true/false value. 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. @@ -726,17 +775,8 @@ C<< $r->action >>. =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; @@ -765,17 +805,17 @@ sub is_model_applicable . 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 @@ -1074,8 +1114,6 @@ backend. Otherwise, see L =cut -sub get_template_root {'.'} - =back =head2 Request properties