X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FApache%2FMVC.pm;h=62afc950f4167080b85b68aa1bed456afa2b5766;hb=421bc934b04227b92c05efc6a60939150b6fc751;hp=30112251cf2473d0fc1a7b03e0ee9265dfdc1d87;hpb=95cf9d3a86c4282f68b1cdd535aee1ae9ac6d303;p=maypole.git diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 3011225..62afc95 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -1,34 +1,55 @@ package Apache::MVC; +our $VERSION = '2.10'; + use strict; use warnings; use base 'Maypole'; -use mod_perl; +use Maypole::Headers; + +BEGIN { + my $version; + eval 'use mod_perl2; $version = $mod_perl2::VERSION; '; + if ($@) { + warn "no mod_perl 2.x using mod_perl 1.x\n"; + use mod_perl; + $version = 0; + require Apache; + require Apache::Request; + } else { + require Apache2::RequestIO; + require Apache2::RequestRec; + require Apache2::RequestUtil; + require APR::URI; + require Apache2::Request; + } -use constant APACHE2 => $mod_perl::VERSION >= 1.99; + use constant APACHE2 => $version; -if (APACHE2) { - require Apache2; - require Apache::RequestRec; - require Apache::RequestUtil; - require APR::URI; } -else { require Apache } -require Apache::Request; - -our $VERSION = "0.4"; sub get_request { my ( $self, $r ) = @_; - $self->{ar} = Apache::Request->new($r); + $self->{ar} = (APACHE2) ? Apache2::Request->new($r) : Apache::Request->new($r); } sub parse_location { my $self = shift; + + # Reconstruct the request headers + $self->headers_in(Maypole::Headers->new); + my %headers; + if (APACHE2) { %headers = %{$self->{ar}->headers_in}; + } else { %headers = $self->{ar}->headers_in; } + for (keys %headers) { + $self->headers_in->set($_, $headers{$_}); + } + $self->{path} = $self->{ar}->uri; my $loc = $self->{ar}->location; no warnings 'uninitialized'; + $self->{path} .= '/' if $self->{path} eq $loc; $self->{path} =~ s/^($loc)?\///; $self->parse_path; $self->parse_args; @@ -43,8 +64,19 @@ sub parse_args { sub send_output { my $r = shift; $r->{ar}->content_type( - $r->{content_type} . "; charset=" . $r->{document_encoding} ); - $r->{ar}->headers_out->set( "Content-Length" => length $r->{output} ); + $r->{content_type} =~ m/^text/ + ? $r->{content_type} . "; charset=" . $r->{document_encoding} + : $r->{content_type} + ); + $r->{ar}->headers_out->set( + "Content-Length" => do { use bytes; length $r->{output} } + ); + + foreach ($r->headers_out->field_names) { + next if /^Content-(Type|Length)/; + $r->{ar}->headers_out->set($_ => $r->headers_out->get($_)); + } + APACHE2 || $r->{ar}->send_http_header; $r->{ar}->print( $r->{output} ); } @@ -85,47 +117,9 @@ Apache::MVC - Apache front-end to Maypole =head1 DESCRIPTION -Maypole is a Perl web application framework to Java's struts. It is -essentially completely abstracted, and so doesn't know anything about -how to talk to the outside world. C is a mod_perl based -subclass of Maypole. - -To use it, you need to create a package which represents your entire -application. In our example above, this is the C package. - -This needs to first inherit from C, and then call setup. -This will give your package an Apache-compatible C subroutine, -and then pass any parameters onto the C method of the -model class. The default model class for Maypole uses L to -map a database to classes, but this can be changed by messing with the -configuration. (B calling setup.) - -Next, you should configure your application through the C -method. Configuration parameters at present are: - -=over - -=item uri_base - -You B specify this; it is the base URI of the application, which -will be used to construct links. - -=item display_tables - -If you do not want all of the tables in the database to be accessible, -then set this to a list of only the ones you want to display - -=item rows_per_page - -List output is paged if you set this to a positive number of rows. - -=back - -You should also set up relationships between your classes, such that, -for instance, calling C on a C object returns an -object representing its associated brewery. - -For a full example, see the included "beer database" application. +A mod_perl platform driver for Maypole. Your application can inherit from +Apache::MVC directly, but it is recommended that you use +L. =head1 INSTALLATION @@ -181,3 +175,5 @@ Screwed up by Sebastian Riedel, C =head1 LICENSE You may distribute this code under the same terms as Perl itself. + +=cut