From 8d3f7b6c5612270c10042d8e0a9e52ad4ad54a46 Mon Sep 17 00:00:00 2001 From: Aaron Trevena 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 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 distribution. - -=item beerfb.riverside-cms.co.uk - -A demo of L. This site is running on the set of Mason -templates included in the L distribution. See the -synopsis of L 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 chapter and our case studies. -=head2 What Maypole wants from a model - -=head2 Building your own model class - =head2 Links L, 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 + +
+ + ... + + + + . . . + + + + . . . + + + ##################################################### + # 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.2