From 1b3ec28e5f2b7f6f5f4c8140a98e114912271a53 Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Thu, 8 Jan 2004 15:52:53 +0000 Subject: [PATCH] Just check-pointing. Written most of the MVC class itself, need to start testing. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@3 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 6 ++ MANIFEST | 7 +++ Makefile.PL | 12 ++++ README | 38 +++++++++++++ lib/Apache/MVC.pm | 103 ++++++++++++++++++++++++++++++++++ lib/Apache/MVC/Workflow.pod | 109 ++++++++++++++++++++++++++++++++++++ t/1.t | 17 ++++++ 7 files changed, 292 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Apache/MVC.pm create mode 100644 lib/Apache/MVC/Workflow.pod create mode 100644 t/1.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..862165e --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Apache::MVC. + +0.01 Thu Jan 8 15:50:17 2004 + - original version; created by h2xs 1.22 with options + -AX -b 5.6.0 -n Apache::MVC + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..445c3ba --- /dev/null +++ b/MANIFEST @@ -0,0 +1,7 @@ +Changes +MANIFEST +Makefile.PL +README +lib/Apache/MVC.pm +lib/Apache/MVC/Workflow.pod +t/1.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..668a722 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,12 @@ +use 5.006; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'Apache::MVC', + VERSION_FROM => 'MVC.pm', # finds $VERSION + PREREQ_PM => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'MVC.pm', # retrieve abstract from module + AUTHOR => 'Simon Cozens ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..136b43c --- /dev/null +++ b/README @@ -0,0 +1,38 @@ +Apache/MVC version 0.01 +======================= + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the +README file from a module distribution so that people browsing the +archive can use it get an idea of the modules uses. It is usually a +good idea to provide version information here so that people can +decide whether fixes for the module are worth downloading. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + blah blah blah + +COPYRIGHT AND LICENCE + +Put the correct copyright and licence information here. + +Copyright (C) 2004 Simon Cozens + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm new file mode 100644 index 0000000..a68f0ac --- /dev/null +++ b/lib/Apache/MVC.pm @@ -0,0 +1,103 @@ +package Apache::MVC; +use base qw(Class::Accessor Class::Data::Inheritable); +use attributes (); +use Class::DBI::Loader; +use strict; +use warnings; + +__PACKAGE__->mk_classdata(qw( _config init_done view_object )); +__PACKAGE__->mk_accessors ( qw( config ar params objects model_class args )); +__PACKAGE__->config({}); +__PACKAGE__->init_done(0); + +# This is really dirty. +sub config { + my $self = shift; + if (ref $self) { return $self->_config_accessor(@_) } + return $self->_config(@_); +} + +sub set_database { + my ($calling_class, $dsn) = @_; + $calling_class = ref $calling_class if ref $calling_class; + $calling_class->config->{dsn} = $dsn; + $calling_class->config->{loader} = Class::DBI::Loader->new( + namespace => $calling_class, + dsn => $dsn + ); +} + +sub init { + my $class = shift; + my $config = $class->config; + $config->{model} ||= "Apache::MVC::Model::CDBI"; + $config->{view} ||= "Apache::MVC::View::TT"; + $config->{classes} = [ $class->config->{loader}->classes ]; + $config->{display_tables} ||= [ $class->config->{loader}->tables ]; + for my $class (@{$config->{classes}}) { + no strict 'refs'; + push @{$class."::ISA"}, $class->config->{model}; + } + $class->view_object($class->config->{view}->new); + +} + +sub class_of { + my ($self, $table) = @_; + return $self->config->{loader}->_table2class($table); +} + +sub handler { + # See Apache::MVC::Workflow before trying to understand this. + my $class = (caller(0))[0]; + $class->init unless $class->init_done; + my $r = bless { config => $class->config }, $class; + $r->get_request(); + $r->parse_location(); + $r->model_class($r->class_of($r->{table})); + my $status = $r->is_applicable; + return $status unless $status == 200; + $status = $r->call_authenticate; + return $status unless $status == 200; + $r->find_objects(); + $r->additional_data(); + $r->class->process($r); +} + +sub get_request { + my $self = shift; + require Apache; require Apache::Request; + $self->{ar} = Apache::Request->new(Apache->request); +} + +sub parse_location { + my $self = shift; + my @pi = split /\//, $self->{ar}->uri(); + shift @pi while @pi and !$pi[0]; + $self->{table} = shift @pi; + $self->{action} = shift @pi; + $self->{args} = \@pi; +} + +sub is_applicable { + my $self = shift; + require Apache::Constants; + Apache::Constants->import(":common"); + my $config = $self->config; + my %ok = map {$_ => 1} @{$config->{displaying_tables}}; + return DECLINED() unless exists $ok{$self->{table}}; + + # Does the action method exist? + my $cv = $self->model_class->can($self->{action}); + return DECLINED() unless $cv; + + # Is it exported? + my $attribs = join " ", attributes::get($cv); + return DECLINED() unless $attribs =~ /\b(Exported|Class|Single|Multiple)\b/i; + return OK(); +} + + +sub authenticate { return 200 } + +1; diff --git a/lib/Apache/MVC/Workflow.pod b/lib/Apache/MVC/Workflow.pod new file mode 100644 index 0000000..09031c0 --- /dev/null +++ b/lib/Apache/MVC/Workflow.pod @@ -0,0 +1,109 @@ +=pod + +=head1 NAME + +Apache::MVC::Workflow - Describes the progress of a request through Apache::MVC + +=head1 SYNOPSIS + + config $h + | + Apache::MVC $r + Apache::Request | + +---- $r->get_request ---+ + $ar | + | + $r->parse_location + | + $r->is_applicable + | + BeerDB::Beer $r->call_authenticate + ->authenticate ------------+------------ $r->authenticate + | + $r->find_objects + | + $r->additional_data + | + $r->model_class->process($r) + + +=head1 DESCRIPTION + +An application based on C will provide an Apache handler, +and eventually deliver a page. This document explains how that happens, +and how to influence it. We'll use the C project as our example. + +=head2 Initialize class + +When the first request comes in, the class will call its own +C method. This creates a new view object, sets up inheritance +relationships between the model classes and their parent, and so on. + +=head2 Construction + +Once we have initialized, the handler obtains the configuration for your +class, and puts it into a new object. We'll call this a request +I for the purposes of this document; it will be a new C +object. + +=head2 Getting the request + +Next, the handler calls C on the new object to have it +store a copy of the C. Of course, if you're not using +Apache, you might want to subclass this method to return something that +looks like an C object, and possibly also subclass the +next stage too to get more control over what methods are called on your +C-lookalike. C is expected to put the object in the +C slot of the request object. + +=head2 Handling the URL + +Typically, the details of the request will be passed in the URL. This is +done with the C method, which is expected to populate +several slots of the request object. First, C and C +should be populated with the name of the table and the action parts of +the URL. Any other arguments should be placed in a listref in the +C slot, and GET and POST parameters should be arranged into a hash +and placed in the C slot. + +Some people may not like the idea of passing everything around in the +URL; this is the method to override for you. Of course, you'll also need +to provide your own default templates to construct links using your +preferred format. + +=head2 Is this an applicable URL? + +Next, the C method works out if this is actually +something that C should care about - whether the class +exists in the application, whether it supports the given action, and so +on. This should return an Apache status code; C if the request +should proceed, C if it should be passed on to the default +handlers, or whatever other codes for permissions problems. + +=head2 Are we allowed to do this? + +We then look for an appropriate C method to call; first +it will try Calling the C method of the model class, or, +if that does not exist, the C method on itself. By +default, this allows access to everyone for everything. Similarly, this +should return an Apache status code. + +=head2 Find the appropriate objects + +The C method is called to populate the C slot of +the request object with the appropriate objects from the model class. + +This takes the right number of arguments off the C slot by +examining the attributes of the method in question. Read more about this +in L. + +=head2 Add any additional data to the request + +The open-ended C method allows any additional fiddling +with the request object before it is despatched. + +=head2 Ask model to take over + +The C method of the model class is called with the request +object, and is expected to perform any actions it needs, and then +despatch control to the view. diff --git a/t/1.t b/t/1.t new file mode 100644 index 0000000..bb56b7a --- /dev/null +++ b/t/1.t @@ -0,0 +1,17 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 1 }; +use Apache::MVC; +ok(1); # If we made it this far, we're ok. + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + -- 2.39.2