X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=blobdiff_plain;f=lib%2FMaypole.pm;h=2f609d8b0496b1838e5069b403e1f5273afcdc1b;hp=5d3e25963c7f2d29fb8c2f3286ba5031b44c9a25;hb=f19715f56244cc6d862169c2dd656b8a2f3845b5;hpb=3886be13f39d6d3fc8d0b76d4716175df1bb8056 diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 5d3e259..2f609d8 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -6,9 +6,12 @@ use warnings; use Maypole::Config; use Maypole::Constants; use Maypole::Headers; +use Maypole::Components; use URI(); +use File::MMagic::XS qw(:compat); our $VERSION = '2.11'; +our $mmagic = File::MMagic::XS->new(); # proposed privacy conventions: # - no leading underscore - public to custom application code and plugins @@ -419,41 +422,46 @@ leaves the dirty work to C. # BeerDB::handler() and so this inherited implementation will be # found. See e.g. "Practical mod_perl" by Bekman & Cholet for # more information -sub handler : method -{ - # See Maypole::Workflow before trying to understand this. - my ($class, $req) = @_; +sub handler : method { + # See Maypole::Workflow before trying to understand this. + my ($class, $req) = @_; - $class->init unless $class->init_done; + $class->init unless $class->init_done; - my $self = $class->new; - - # initialise the request - $self->headers_out(Maypole::Headers->new); - $self->get_request($req); - $self->parse_location; + my $self = $class->new; - # hook useful for declining static requests e.g. images, or perhaps for - # sanitizing request parameters - $self->status(Maypole::Constants::OK()); # set the default - $self->__call_hook('start_request_hook'); - return $self->status unless $self->status == Maypole::Constants::OK(); + # initialise the request + $self->headers_out(Maypole::Headers->new); + $self->get_request($req); + $self->parse_location; - die "status undefined after start_request_hook()" unless defined - $self->status; + # hook useful for declining static requests e.g. images, or perhaps for + # sanitizing request parameters + $self->status(Maypole::Constants::OK()); # set the default + $self->__call_hook('start_request_hook'); + return $self->status unless $self->status == Maypole::Constants::OK(); - $self->get_session; - $self->get_user; + die "status undefined after start_request_hook()" unless defined + $self->status; - my $status = $self->handler_guts; - return $status unless $status == OK; + $self->get_session; + $self->get_user; - # TODO: require send_output to return a status code - $self->send_output; + my $status = $self->handler_guts; + return $status unless $status == OK; - return $status; + # TODO: require send_output to return a status code + $self->send_output; + + return $status; +} + +sub component { + my $component = Maypole::Components->new(@_); + return $component->handler; } + # 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 # @ISA and call them all here. Doesn't work for setup() though, because it's @@ -553,9 +561,32 @@ sub handler_guts # 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 - return $self->__call_process_view; + my $processed_view_ok = $self->__call_process_view; + + $self->{content_type} ||= $self->__get_mime_type(); + $self->{document_encoding} ||= "utf-8"; + + return $processed_view_ok; +} + +my %filetypes = ( + 'js' => 'text/javascript', + 'css' => 'text/css', + 'htm' => 'text/html', + 'html' => 'text/html', + ); + +sub __get_mime_type { + my $self = shift; + my $type; + if ($self->path =~ m/.*\.(\w{3,4})$/) { + $type = $filetypes{$1}; + } else { + $type = $mmagic->checktype_contents($self->output); + } + return $type; } sub __load_request_model @@ -741,7 +772,7 @@ sub is_model_applicable return 1 if $self->model_class->is_public($action); warn "The action '$action' is not applicable to the table '$table'" - if $self->debug; + if $self->debug; return 0; }