From 8d3f7b6c5612270c10042d8e0a9e52ad4ad54a46 Mon Sep 17 00:00:00 2001
From: Aaron Trevena <aaron.trevena@gmail.com>
Date: Thu, 20 Jul 2006 12:33:12 +0000
Subject: [PATCH] upped Class::DBI::SQLite requirement, quiettened tests and
build, cleaned up documentation a bit. this is 2.11_pre5 and should hopefully
turn out to be 2.11 final
git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@513 48953598-375a-da11-a14b-00016c27c3ee
---
Makefile.PL | 2 +-
lib/Maypole.pm | 32 ++-------
lib/Maypole/Manual/Model.pod | 4 --
lib/Maypole/Model/CDBI.pm | 9 ++-
lib/Maypole/Model/CDBI/AsForm.pm | 109 ++++++++++++++++++++++++------
lib/Maypole/Model/CDBI/FromCGI.pm | 2 +-
lib/Maypole/Model/CDBI/Plain.pm | 12 ++++
t/01basics.t | 2 +-
t/db_colinfo.t | 1 -
t/pathtools.t | 3 -
10 files changed, 115 insertions(+), 61 deletions(-)
diff --git a/Makefile.PL b/Makefile.PL
index 9d192e0..935c677 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -13,7 +13,7 @@ WriteMakefile(
Class::DBI::Plugin::RetrieveAll => 0,
Class::DBI::Loader::Relationship => 0,
Class::DBI => 0.96,
- Class::DBI::SQLite => 0,
+ Class::DBI::SQLite => 0.08,
CGI::Untaint => 1.26,
CGI::Untaint::date => 0,
CGI::Untaint::email => 0,
diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 0d0250d..03205a6 100644
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -91,7 +91,7 @@ configuration (B<before> calling setup.)
Note that some details in some of these resources may be out of date.
-=over 4
+=over 4
=item The Maypole Manual
@@ -120,7 +120,7 @@ may be out of date.
=item Web applications with Maypole
A tutorial written by Simon Cozens for YAPC::EU 2005 -
-http://www.droogs.org/perl/maypole/maypole-tutorial.pdf [228KB].
+http://www.aarontrevena.co.uk/opensource/maypole/maypole-tutorial.pdf [228KB].
=item A Database-Driven Web Application in 18 Lines of Code
@@ -148,7 +148,7 @@ http://www.perl.com/pub/a/2004/04/15/maypole.html
=item Authentication
Some notes written by Simon Cozens. A little bit out of date, but still
-very useful: http://www.droogs.org/perl/maypole/authentication.html
+very useful: http://www.aarontrevena.co.uk/opensource/maypole/authentication.html
=item CheatSheet
@@ -173,30 +173,6 @@ http://cpanratings.perl.org/dist/Maypole
=back
-=head1 DEMOS
-
-A couple of demos are available, sometimes with source code and configs.
-
-=over 4
-
-=item http://maypole.perl.org/beerdb/
-
-The standard BeerDB example, using the TT factory templates supplied in the
-distribution.
-
-=item beerdb.riverside-cms.co.uk
-
-The standard BeerDB example, running on Mason, using the factory templates
-supplied in the L<MasonX::Maypole> distribution.
-
-=item beerfb.riverside-cms.co.uk
-
-A demo of L<Maypole::FormBuilder>. This site is running on the set of Mason
-templates included in the L<Maypole::FormBuilder> distribution. See the
-synopsis of L<Maypole::Plugin::FormBuilder> for an example driver
-
-=back
-
=cut
__PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes_loaded);
@@ -255,7 +231,7 @@ Some packages respond to higher debug levels, try increasing it to 2 or 3.
=cut
-sub debug { 1 }
+sub debug { 0 }
=item config
diff --git a/lib/Maypole/Manual/Model.pod b/lib/Maypole/Manual/Model.pod
index c99a189..112effc 100644
--- a/lib/Maypole/Manual/Model.pod
+++ b/lib/Maypole/Manual/Model.pod
@@ -113,10 +113,6 @@ We'll look more at how to put together actions in the
L<Standard Templates and Actions|Maypole::Manual::StandardTemplates>
chapter and our case studies.
-=head2 What Maypole wants from a model
-
-=head2 Building your own model class
-
=head2 Links
L<Contents|Maypole::Manual>,
diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index 60619a0..bd9646f 100644
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -239,10 +239,13 @@ the, now deprecated, search method previously provided.
sub search : Exported {
my $self = shift;
my ($sub) = (caller(1))[3];
- $sub =~ /^(.+)::([^:]+)$/;
# So subclasses can still send search down ...
- return ($1 ne "Maypole::Model::Base" && $2 ne "search") ?
- $self->SUPER::search(@_) : $self->do_search(@_);
+ if ($sub =~ /^(.+)::([^:]+)$/) {
+ return ($1 ne "Maypole::Model::Base" && $2 ne "search") ?
+ $self->SUPER::search(@_) : $self->do_search(@_);
+ } else {
+ $self->SUPER::search(@_);
+ }
}
sub do_search : Exported {
diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index 2c5f60d..02403e0 100644
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -53,25 +53,93 @@ Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns
end_form;
}
-# Example of has_many select
-package Job;
-__PACKAGE__->has_a('job_employer' => 'Employer');
-__PACKAGE__->has_a('contact' => 'Contact')
-
-package Contact;
-__PACKAGE__->has_a('cont_employer' => 'Employer');
-__PACKAGE__->has_many('jobs' => 'Job',
- { join => { job_employer => 'cont_employer' },
- constraint => { 'finshed' => 0 },
- order_by => "created ASC",
- }
-);
-
-package Employer;
-__PACKAGE__->has_many('jobs' => 'Job',);
-__PACKAGE__->has_many('contacts' => 'Contact',
- order_by => 'name DESC',
-);
+
+ . . .
+
+ # Somewhere else in a Maypole application about beer...
+
+
+
+
+ $beer->to_field('brewery', 'textfield', {
+ name => 'brewery_id', value => $beer->brewery,
+ # however, no need to set value since $beer is object
+ });
+
+ # Rate a beer
+ $beer->to_field(rating => select => {
+ items => [1 , 2, 3, 4, 5],
+ });
+
+ # Select a Brewery to visit in the UK
+ Brewery->to_field(brewery_id => {
+ items => [ Brewery->search_like(location => 'UK') ],
+ });
+
+ # Make a select for a boolean field
+ $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] });
+
+ $beer->to_field('brewery', {
+ selected => $beer->brewery, # again not necessary since caller is obj.
+ });
+
+
+ $beer->to_field('brewery', 'link_hidden', {r => $r, uri => 'www.maypole.perl.org/brewery/view/'.$beer->brewery});
+ # an html link that is also a hidden input to the object. R is required to
+ # make the uri unless you pass a uri
+
+
+
+ #####################################################
+ # Templates Usage
+
+ <form ..>
+
+ ...
+
+ <label>
+
+ <span class="field"> [% classmetadata.colnames.$col %] : </span>
+
+ [% object.to_field(col).as_XML %]
+
+ </label>
+
+ . . .
+
+ <label>
+
+ <span class="field"> Brewery : </span>
+
+ [% object.to_field('brewery', { selected => 23} ).as_XML %]
+
+ </label>
+
+ . . .
+
+
+ #####################################################
+ # Advanced Usage
+
+ # has_many select
+ package Job;
+ __PACKAGE__->has_a('job_employer' => 'Employer');
+ __PACKAGE__->has_a('contact' => 'Contact')
+
+ package Contact;
+ __PACKAGE__->has_a('cont_employer' => 'Employer');
+ __PACKAGE__->has_many('jobs' => 'Job',
+ { join => { job_employer => 'cont_employer' },
+ constraint => { 'finshed' => 0 },
+ order_by => "created ASC",
+ }
+ );
+
+ package Employer;
+ __PACKAGE__->has_many('jobs' => 'Job',);
+ __PACKAGE__->has_many('contacts' => 'Contact',
+ order_by => 'name DESC',
+ );
# Choose some jobs to add to a contact (has multiple attribute).
@@ -81,6 +149,9 @@ __PACKAGE__->has_many('contacts' => 'Contact',
# Choose a job from $contact->jobs
my $job_sel = $contact->to_field('jobs');
+ 1;
+
+
=head1 DESCRIPTION
diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm
index 9baaf9e..cc27533 100644
--- a/lib/Maypole/Model/CDBI/FromCGI.pm
+++ b/lib/Maypole/Model/CDBI/FromCGI.pm
@@ -18,7 +18,7 @@ Maypole::Model:CDBI::FromCGI - Validate form input and populate Model objects
$obj = $obj->add_to_from_cgi($r);
$obj = $obj->add_to_from_cgi($r, { params => {...} } );
-
+
# This does not work like in CDBI::FromCGI and probably never will :
# $class->update_from_cgi($h, @columns);
diff --git a/lib/Maypole/Model/CDBI/Plain.pm b/lib/Maypole/Model/CDBI/Plain.pm
index fd34a75..3c3296a 100644
--- a/lib/Maypole/Model/CDBI/Plain.pm
+++ b/lib/Maypole/Model/CDBI/Plain.pm
@@ -17,6 +17,18 @@ Maypole::Model::CDBI::Plain - Class::DBI model without ::Loader
Foo->config->model("Maypole::Model::CDBI::Plain");
Foo->setup([qw/ Foo::SomeTable Foo::Other::Table /]);
+ # untaint columns and provide custom actions for each class
+
+ Foo::SomeTable->untaint_columns(email => ['email'], printable => [qw/name description/]);
+
+ Foo::Other::Table->untaint_columns ( ... );
+
+ sub Foo::SomeTable::SomeAction : Exported {
+
+ . . .
+
+ }
+
=head1 DESCRIPTION
This module allows you to use Maypole with previously set-up
diff --git a/t/01basics.t b/t/01basics.t
index fb79598..ba7b834 100644
--- a/t/01basics.t
+++ b/t/01basics.t
@@ -2,7 +2,7 @@
use Test::More;
use lib 'ex'; # Where BeerDB should live
BEGIN {
- $ENV{BEERDB_DEBUG} = 2;
+ $ENV{BEERDB_DEBUG} = 0;
eval { require BeerDB };
Test::More->import( skip_all =>
diff --git a/t/db_colinfo.t b/t/db_colinfo.t
index 4a4846a..471d059 100755
--- a/t/db_colinfo.t
+++ b/t/db_colinfo.t
@@ -149,7 +149,6 @@ SKIP: {
skip $skip_msg, $skip_howmany if $err;
$DB_Class->table($table);
#use Data::Dumper;
-#warn "colinfo is " . Dumper($DB_Class->_column_info());
run_method_tests($DB_Class,'column_type', %correct_types);
# No support default
#run_method_tests($DB_Class,'column_default', %correct_defaults);
diff --git a/t/pathtools.t b/t/pathtools.t
index 08f4b60..a5404b7 100644
--- a/t/pathtools.t
+++ b/t/pathtools.t
@@ -79,9 +79,6 @@ my @bases = ( 'http://www.example.com',
my ($uri_basepath,$uri_query) = split(/\?/,$uri);
- warn "\nuri : '$uri'\nexpected : '$expected'\n";
- warn "uri_basepath : $uri_basepath, uri_query : $uri_query\n";
-
my $q_got = new CGI($uri_query);
if ($uri_query) {
--
2.39.5