From 5c199c0e9cd05a00bfc04d9688982979a41f3ee8 Mon Sep 17 00:00:00 2001 From: Sebastian Riedel Date: Thu, 9 Sep 2004 16:59:57 +0000 Subject: [PATCH] Merged Apache2::MVC into Apache::MVC, deprecated $r->{query} git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@170 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 5 +- lib/Apache/MVC.pm | 59 ++++++++++++++--- lib/Apache/MVC/Base.pm | 50 -------------- lib/Apache2/MVC.pm | 132 ------------------------------------- lib/Maypole/Application.pm | 11 +--- 5 files changed, 55 insertions(+), 202 deletions(-) delete mode 100644 lib/Apache/MVC/Base.pm delete mode 100644 lib/Apache2/MVC.pm diff --git a/Changes b/Changes index 2d0b1a3..1b2bc76 100644 --- a/Changes +++ b/Changes @@ -3,9 +3,10 @@ Revision history for Perl extension Maypole 1.8 XXX XXX XX XX:XX:XX XXX XXXX - Added parse_args() (Simon Flack) - call additional_data() and authenticate() for plain templates - - added Apache2::MVC mod_perl2 front-end + - merged Apache2::MVC (mod_perl2 support) into Apache::MVC - added Maypole::Application universal loader - - added Apache::MVC::Base base class for Apache front-ends + - config parameter handling for Maypole::Model::CDBI + - $r->{query} is now deprecated, use $r->{params} for GET and POST 1.7 Sat Jul 17 20:15:26 BST 2004 - Emergency release - we lost the "use Maypole::Constants" from diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 5005eff..320b6b7 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -1,24 +1,64 @@ package Apache::MVC; -use base qw(Apache::MVC::Base Maypole); -use Apache; -use Apache::Request; use strict; use warnings; -our $VERSION = "0.3"; +use base 'Maypole'; +use mod_perl; + +if ( $mod_perl::VERSION >= 1.99 ) { + require Apache2; + require Apache::RequestRec; + require Apache::RequestUtil; + require APR::URI; +} +else { require Apache } +require Apache::Request; + +our $VERSION = "0.4"; sub get_request { - shift->{ar} = Apache::Request->new( Apache->request ); + my ( $self, $r ) = @_; + $self->{ar} = Apache::Request->new($r); +} + +sub parse_location { + my $self = shift; + $self->{path} = $self->{ar}->uri; + my $loc = $self->{ar}->location; + no warnings 'uninitialized'; + $self->{path} =~ s/^($loc)?\///; + $self->parse_path; + $self->parse_args; } sub parse_args { my $self = shift; - $self->{params} = { $self->{ar}->content }; - while ( my ( $key, $value ) = each %{ $self->{params} } ) { - $self->{params}{$key} = '' unless defined $value; + $self->{params} = { $self->_mod_perl_args( $self->{ar} ) }; + $self->{query} = { $self->_mod_perl_args( $self->{ar} ) }; +} + +sub send_output { + my $r = shift; + $r->{ar}->content_type( $r->{content_type} ); + $r->{ar}->headers_out->set( "Content-Length" => length $r->{output} ); + $r->{ar}->send_http_header; + $r->{ar}->print( $r->{output} ); +} + +sub get_template_root { + my $r = shift; + $r->{ar}->document_root . "/" . $r->{ar}->location; +} + +sub _mod_perl_args { + my ( $self, $apr ) = @_; + my %args; + foreach my $key ( $apr->param ) { + my @values = $apr->param($key); + $args{$key} = @values == 1 ? $values[0] : \@values; } - $self->{query} = { $self->{ar}->args }; + return %args; } 1; @@ -113,6 +153,7 @@ see L. =head1 AUTHOR Simon Cozens, C +Marcus Ramberg, C Screwed up by Sebastian Riedel, C =head1 LICENSE diff --git a/lib/Apache/MVC/Base.pm b/lib/Apache/MVC/Base.pm deleted file mode 100644 index 996240d..0000000 --- a/lib/Apache/MVC/Base.pm +++ /dev/null @@ -1,50 +0,0 @@ -package Apache::MVC::Base; - -use strict; -use warnings; - -sub parse_location { - my $self = shift; - $self->{path} = $self->{ar}->uri; - my $loc = $self->{ar}->location; - no warnings 'uninitialized'; - $self->{path} =~ s/^($loc)?\///; - $self->parse_path; - $self->parse_args; -} - -sub send_output { - my $r = shift; - $r->{ar}->content_type( $r->{content_type} ); - $r->{ar}->headers_out->set( "Content-Length" => length $r->{output} ); - $r->{ar}->send_http_header; - $r->{ar}->print( $r->{output} ); -} - -sub get_template_root { - my $r = shift; - $r->{ar}->document_root . "/" . $r->{ar}->location; -} - -1; - -=head1 NAME - -Apache::MVC::Base - Apache front-end base class - -=head1 SYNOPSIS - - use base 'Apache::Maypole::Base'; - -=head1 DESCRIPTION - -The base class for the Apache and Apache2 front-ends. - -=head1 AUTHOR - -Simon Cozens, C -Screwed up by Sebastian Riedel, C - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. diff --git a/lib/Apache2/MVC.pm b/lib/Apache2/MVC.pm deleted file mode 100644 index 2c6ceb7..0000000 --- a/lib/Apache2/MVC.pm +++ /dev/null @@ -1,132 +0,0 @@ -package Apache2::MVC; - -use base qw(Apache::MVC::Base Maypole); -use Apache2; -use Apache::RequestRec; -use Apache::RequestUtil; -use Apache::Request; -use APR::URI; -use strict; -use warnings; - -our $VERSION = "0.1"; - -sub get_request { - my ( $self, $r ) = @_; - $self->{ar} = Apache::Request->new($r); -} - -sub parse_args { - my $self = shift; - $self->{params} = { $self->_mod_perl_args( $self->{ar} ) }; - $self->{query} = { $self->_mod_perl_args( $self->{ar} ) }; -} - -sub _mod_perl_args { - my ( $self, $apr ) = @_; - my %args; - foreach my $key ( $apr->param ) { - my @values = $apr->param($key); - $args{$key} = @values == 1 ? $values[0] : \@values; - } - return %args; -} - -1; - -=head1 NAME - -Apache2::MVC - Apache2 front-end to Maypole - -=head1 SYNOPSIS - - package BeerDB; - use base 'Apache::MVC'; - BeerDB->setup("dbi:mysql:beerdb"); - BeerDB->config->{uri_base} = "http://your.site/"; - BeerDB->config->{display_tables} = [qw[beer brewery pub style]]; - # Now set up your database: - # has-a relationships - # untaint columns - - 1; - -=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_perl2 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. - -=head1 INSTALLATION - -Create a driver module like the one above. - -Put the following in your Apache config: - - - SetHandler perl-script - PerlHandler BeerDB - - -Copy the templates found in F into the -F directory off the web root. When the designers get -back to you with custom templates, they are to go in -F. If you need to do override templates on a -database-table-by-table basis, put the new template in -F>. - -This will automatically give you C, C, C, C and -C commands; for instance, a list of breweries, go to - - http://your.site/beer/brewery/list - -For more information about how the system works and how to extend it, -see L. - -=head1 AUTHOR - -Simon Cozens, C -Marcus Ramberg, C -Screwed up by Sebastian Riedel, C - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. diff --git a/lib/Maypole/Application.pm b/lib/Maypole/Application.pm index 2727c9a..c2d58dc 100644 --- a/lib/Maypole/Application.pm +++ b/lib/Maypole/Application.pm @@ -4,15 +4,8 @@ use strict; use warnings; if ( $ENV{MOD_PERL} ) { - require mod_perl; - if ( $mod_perl::VERSION >= 1.99 ) { - require Apache2::MVC; - our @ISA = qw(Apache2::MVC); - } - else { - require Apache::MVC; - our @ISA = qw(Apache::MVC); - } + require Apache::MVC; + our @ISA = qw(Apache::MVC); } else { require CGI::Maypole; -- 2.39.5