X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=2f609d8b0496b1838e5069b403e1f5273afcdc1b;hb=f19715f56244cc6d862169c2dd656b8a2f3845b5;hp=119a85a29127c9908581bfa6afb34b667d0bd5c9;hpb=a02686080acb66fce170e9657e110761b09e62a2;p=maypole.git

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 119a85a..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
@@ -194,7 +197,7 @@ synopsis of L<Maypole::Plugin::FormBuilder> for an example driver
 
 =cut
 
-__PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
+__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
@@ -206,6 +209,8 @@ __PACKAGE__->config( Maypole::Config->new() );
 
 __PACKAGE__->init_done(0);
 
+__PACKAGE__->model_classes_loaded(0);
+
 =head1 HOOKABLE METHODS
 
 As a framework, Maypole provides a number of B<hooks> - methods that are
@@ -306,15 +311,16 @@ sub setup_model
     
     foreach my $subclass ( @{ $config->classes } ) 
     {
-        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);
-        
-        $config->model->adopt($subclass) if $config->model->can("adopt");
+      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");
     }
 }
 
@@ -416,41 +422,46 @@ leaves the dirty work to C<handler_guts>.
 # BeerDB::handler() and so this inherited implementation will be
 # found. See e.g. "Practical mod_perl" by Bekman & Cholet for
 # more information <http://modperlbook.org/html/ch25_01.html>
-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;
+  my $self = $class->new;
     
-    # initialise the request
-    $self->headers_out(Maypole::Headers->new);
-    $self->get_request($req);
-    $self->parse_location;
+  # initialise the request
+  $self->headers_out(Maypole::Headers->new);
+  $self->get_request($req);
+  $self->parse_location;
     
-    # 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();
+  # 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();
     
-    die "status undefined after start_request_hook()" unless defined
-        $self->status;
+  die "status undefined after start_request_hook()" unless defined
+    $self->status;
     
-    $self->get_session;
-    $self->get_user;
+  $self->get_session;
+  $self->get_user;
     
-    my $status = $self->handler_guts;
-    return $status unless $status == OK;
-    
-    # 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 
@@ -550,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
@@ -738,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;
 }