Added Maypole::Config, and changed other classes to reflect that.

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@197 48953598-375a-da11-a14b-00016c27c3ee

diff --git a/TODO b/TODO
index 941c95778fb0751a24b4f870b66a365b21d04ff9..b8cf76731fe240795676dda4ab5a2164b85e9b66 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,3 +1,2 @@
 * Tests
 * Better Documentation and more complex examples
-* Make templates XHTML compliant

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index 044c1a7c7adfc657ce01f2c80b0827e7c9f4b1ca..c175d1a059302fb17727ff7aebc8beab90f11577 100644 (file)
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -74,8 +74,8 @@ Apache::MVC - Apache front-end to Maypole
     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]];
+    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

diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index bc313216d0e9adc268abf5fcd9db2f254a7bf35b..67cbf92f1c08e34325e1c767b5ffb845393632ff 100644 (file)
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -62,8 +62,8 @@ CGI::Maypole - CGI-based front-end to Maypole
      package BeerDB;
      use base 'CGI::Maypole;
      BeerDB->setup("dbi:mysql:beerdb");
-     BeerDB->config->{uri_base} = "http://your.site/cgi-bin/beer.cgi/";
-     BeerDB->config->{display_tables} = [qw[beer brewery pub style]];
+     BeerDB->config->uri_base("http://your.site/cgi-bin/beer.cgi/");
+     BeerDB->config->display_tables([qw[beer brewery pub style]]);
      # Now set up your database:
      # has-a relationships
      # untaint columns

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 4a5201127794ab8c8936cd322eeeb62de83395b1..29c8917d81022b5ed699c76c8f0b196677fd6d3f 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -4,13 +4,14 @@ use attributes ();
 use UNIVERSAL::require;
 use strict;
 use warnings;
+use Maypole::Config;
 our $VERSION = "1.8";
 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __PACKAGE__->mk_accessors(
     qw( ar params query objects model_class
       args action template )
 );
-__PACKAGE__->config( {} );
+__PACKAGE__->config( Maypole::Config->new() );
 __PACKAGE__->init_done(0);
 use Maypole::Constants;
 
@@ -27,26 +28,26 @@ sub setup {
           sub { Maypole::handler( $calling_class, @_ ) };
     }
     my $config = $calling_class->config;
-    $config->{model} ||= "Maypole::Model::CDBI";
-    $config->{model}->require;
-    die "Couldn't load the model class $config->{model}: $@" if $@;
-    $config->{model}->setup_database( $config, $calling_class, @_ );
-    for my $subclass ( @{ $config->{classes} } ) {
+    $config->model || $config->model("Maypole::Model::CDBI");
+    $config->model->require;
+    die "Couldn't load the model class $config->model: $@" if $@;
+    $config->model->setup_database( $config, $calling_class, @_ );
+    for my $subclass ( @{ $config->classes } ) {
         no strict 'refs';
-        unshift @{ $subclass . "::ISA" }, $config->{model};
-        $config->{model}->adopt($subclass)
-          if $config->{model}->can("adopt");
+        unshift @{ $subclass . "::ISA" }, $config->model;
+        $config->model->adopt($subclass)
+          if $config->model->can("adopt");
     }
 }
 
 sub init {
     my $class  = shift;
     my $config = $class->config;
-    $config->{view} ||= "Maypole::View::TT";
-    $config->{view}->require;
-    die "Couldn't load the view class $config->{view}: $@" if $@;
-    $config->{display_tables} ||= [ @{ $class->config->{tables} } ];
-    $class->view_object( $class->config->{view}->new );
+    $config->view || $config->view("Maypole::View::TT");
+    $config->view->require;
+    die "Couldn't load the view class ".$config->view.": $@" if $@;
+    $config->display_tables || $config->display_tables([ $class->config->tables ]);
+    $class->view_object( $class->config->view->new );
     $class->init_done(1);
 
 }
@@ -67,7 +68,7 @@ sub handler {
 
 sub handler_guts {
     my $r = shift;
-    $r->model_class( $r->config->{model}->class_of( $r, $r->{table} ) );
+    $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
     my $applicable = $r->is_applicable;
     unless ( $applicable == OK ) {
 
@@ -122,13 +123,13 @@ sub handler_guts {
 sub is_applicable {
     my $self   = shift;
     my $config = $self->config;
-    $config->{ok_tables} ||= $config->{display_tables};
-    $config->{ok_tables} = { map { $_ => 1 } @{ $config->{ok_tables} } }
-      if ref $config->{ok_tables} eq "ARRAY";
+    $config->ok_tables || $config->ok_tables($config->display_tables);
+    $config->ok_tables ({ map { $_ => 1 } @{ $config->ok_tables } })
+      if ref $config->ok_tables eq "ARRAY";
     warn "We don't have that table ($self->{table})"
       if $self->debug
-      and not $config->{ok_tables}{ $self->{table} };
-    return DECLINED() unless exists $config->{ok_tables}{ $self->{table} };
+      and not $config->ok_tables->{ $self->{table} };
+    return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
 
     # Does the action method exist?
     my $cv = $self->model_class->can( $self->{action} );
@@ -220,7 +221,7 @@ this:
     package ProductDatabase;
     use base 'Apache::MVC';
     __PACKAGE__->set_database("dbi:mysql:products");
-    ProductDatabase->config->{uri_base} = "http://your.site/catalogue/";
+    ProductDatabase->config->uri_base = "http://your.site/catalogue/";
     ProductDatabase::Product->has_a("category" => ProductDatabase::Category); 
     # ...
 
@@ -278,7 +279,7 @@ subclass the model class, and configure your class slightly differently:
 Then your top-level application package should change the model class:
 (Before calling C<setup>)
 
-    ProductDatabase->config->{model} = "ProductDatabase::Model";
+    ProductDatabase->config->model("ProductDatabase::Model");
 
 (The C<:Exported> attribute means that the method can be called via the
 URL C</I<table>/supersearch/...>.)

diff --git a/lib/Maypole/CLI.pm b/lib/Maypole/CLI.pm
index fec6f5e8739929565c624f7b9e27499a9ef2abee..49f267584cf994d1a169c125f24539a37007dcf3 100644 (file)
--- a/lib/Maypole/CLI.pm
+++ b/lib/Maypole/CLI.pm
@@ -22,8 +22,8 @@ sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." }
 
 sub parse_location {
     my $self = shift;
-    my $url  = URI->new( shift @ARGV );
-    my $root = URI->new( $self->config->{uri_base} )->path;
+    my $url  = URI->new(shift @ARGV);
+    my $root = URI->new($self->config->uri_base)->path;
     $self->{path} = $url->path;
     $self->{path} =~ s/^$root//i if $root;
     $self->parse_path;

diff --git a/lib/Maypole/Config.pm b/lib/Maypole/Config.pm
new file mode 100644 (file)
index 0000000..b8202cf
--- /dev/null
+++ b/lib/Maypole/Config.pm
@@ -0,0 +1,60 @@
+package Maypole::Config;
+use base qw(Class::Accessor);
+use attributes ();
+#use overload
+#    '""' => sub { shift->stringify_self};
+use strict;
+use warnings;
+
+# Public accessors.
+__PACKAGE__->mk_accessors(
+    qw( view uri_base template_root model loader display_tables ok_tables
+      rows_per_page dsn user pass opts)
+      );
+
+# Should only be modified by model.
+    __PACKAGE__->mk_ro_accessors( qw(
+         classes
+         tables
+         table_to_class
+    ) );
+
+1;
+
+=head1 NAME
+
+Maypole::Config - Maypole Configuration Class
+
+=head1 DESCRIPTION
+
+This class stores all configuration data for your Maypole application.
+
+=head2 view
+
+The view class for your Maypole Application. Defaults to "Maypole::View::TT"
+
+=head2 display_tables 
+
+=head2 ok_tables
+
+=head2 model
+
+=head2 loader
+
+=head2 uri_base 
+
+=head2 classes
+ 
+=head2 rows_per_page
+
+=head2 dsn
+
+=head2 user
+
+=head2 pass
+
+=head2 opts
+
++head2 table_to_root
+
+=head2 template_root

diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index e1d665291f55afb16b78451c2f4ffa60b50315ea..6ad14171255cad627ee61722099fbe4cd190a71a 100644 (file)
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -114,7 +114,7 @@ sub search : Exported {
 
 sub do_pager {
     my ( $self, $r ) = @_;
-    if ( my $rows = $r->config->{rows_per_page} ) {
+    if ( my $rows = $r->config->rows_per_page ) {
         return $r->{template_args}{pager} =
           $self->pager( $rows, $r->query->{page} );
     }
@@ -127,9 +127,9 @@ sub order {
     my %ok_columns = map { $_ => 1 } $self->columns;
     if ( $order = $r->query->{order} and $ok_columns{$order} ) {
         $order .= ( $r->query->{o2} eq "desc" && " DESC" );
+       }
+       $order;
     }
-    $order;
-}
 
 sub list : Exported {
     my ( $self, $r ) = @_;
@@ -144,26 +144,26 @@ sub list : Exported {
 }
 
 sub setup_database {
-    my ( $self, $config, $namespace, $dsn, $u, $p, $opts ) = @_;
-    $dsn  ||= $config->{dsn};
-    $u    ||= $config->{user};
-    $p    ||= $config->{pass};
-    $opts ||= $config->{opts};
-    $config->{dsn}    = $dsn;
-    $config->{loader} = Class::DBI::Loader->new(
+    my ($self, $config, $namespace, $dsn, $u, $p, $opts) = @_;
+    $dsn  ||= $config->dsn;
+    $u    ||= $config->user;
+    $p    ||= $config->pass;
+    $opts ||= $config->opts;
+    $config->dsn($dsn);
+    $config->loader || $config->loader( Class::DBI::Loader->new(
         namespace => $namespace,
-        dsn       => $dsn,
-        user      => $u,
-        password  => $p,
-        options   => $opts,
-    );
+        dsn => $dsn,
+        user => $u,
+        password => $p,
+        options => $opts,
+    ) );
     $config->{classes} = [ $config->{loader}->classes ];
     $config->{tables}  = [ $config->{loader}->tables ];
 }
 
 sub class_of {
     my ( $self, $r, $table ) = @_;
-    return $r->config->{loader}->_table2class($table);
+    return $r->config->loader->_table2class($table);
 }
 
 1;

diff --git a/lib/Maypole/View/Base.pm b/lib/Maypole/View/Base.pm
index 61c887d3ef0bba3c91922a06ec66de8eb5cecc9c..fdc66298adf38c5db34cb02258197ff5a2e441dd 100644 (file)
--- a/lib/Maypole/View/Base.pm
+++ b/lib/Maypole/View/Base.pm
@@ -8,7 +8,7 @@ sub new { bless {}, shift }    # By default, do nothing.
 
 sub paths {
     my ( $self, $r ) = @_;
-    my $root = $r->{config}{template_root} || $r->get_template_root;
+    my $root = $r->config->template_root || $r->get_template_root;
     return (
         $root,
         (
@@ -23,7 +23,7 @@ sub paths {
 sub vars {
     my ( $self, $r ) = @_;
     my $class = $r->model_class;
-    my $base  = $r->{config}->{uri_base};
+    my $base  = $r->config->uri_base;
     $base =~ s/\/+$//;
     my %args = (
         request => $r,

diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm
index 9142f3ebe51bdbda78ffbde8f2a37e5de11f9f50..9a15dfa7044f384490b9f4d30a9f1262fa91897f 100644 (file)
--- a/lib/Maypole/View/TT.pm
+++ b/lib/Maypole/View/TT.pm
@@ -25,7 +25,7 @@ Maypole::View::TT - A Template Toolkit view class for Maypole
 
 =head1 SYNOPSIS
 
-    BeerDB->config->{view} = "Maypole::View::TT"; # The default anyway
+    BeerDB->config->view("Maypole::View::TT"); # The default anyway
 
 =head1 DESCRIPTION
 

diff --git a/t/1.t b/t/1.t
index 50aa24c4d6933994b2903e0db2d1dd045d8f9aa1..3aaa0e986c231f345abcb50447cbf82af24a9e44 100644 (file)
--- a/t/1.t
+++ b/t/1.t
@@ -2,8 +2,8 @@
 use Test::More;
 use lib 'ex'; # Where BeerDB should live
 BEGIN { if (eval { require BeerDB }) { 
-            plan tests => 5;
-        } else { Test::More->import(skip_all =>"SQLite not working or BeerDB module not found: $@") }
+            plan tests => 3;
+        } else { Test::More->import(skip_all =>"SQLite not working or BeerDB module could not be loaded: $@") }
       }
 use Maypole::CLI qw(BeerDB);
 use Maypole::Constants;
@@ -11,10 +11,5 @@ $ENV{MAYPOLE_TEMPLATES} = "t/templates";
 
 isa_ok( (bless {},"BeerDB") , "Maypole");
 
-@ARGV = ("http://localhost/beerdb/");
-is(BeerDB->handler, OK, "OK");
-like($Maypole::CLI::buffer, qr/frontpage/, "Got the front page");
-
-@ARGV = ("http://localhost/beerdb/beer/list");
-is(BeerDB->handler, OK, "OK");
-like($Maypole::CLI::buffer, qr/Organic Best/, "Found a beer in the list");
+like(BeerDB->call_url("http://localhost/beerdb/"), qr/frontpage/, "Got the front page");
+like(BeerDB->call_url("http://localhost/beerdb/beer/list"), qr/Organic Best/, "Found a beer in the list");

diff --git a/t/templates/custom/list b/t/templates/custom/list
index c5f9229538ec798aed1a2ab2c085f541ccd9f3db..59ab236e2d96f43691cdb428db637170d39d4ec7 100644 (file)
--- a/t/templates/custom/list
+++ b/t/templates/custom/list
@@ -1,5 +1,5 @@
 # Begin object list
 [% FOR obj = objects %]
-- [% obj.name %]
+[%obj.id%]: [% obj.name %]
 [% END %]
 # End object list

diff --git a/t/templates/custom/view b/t/templates/custom/view
new file mode 100644 (file)
index 0000000..c5f9229
--- /dev/null
+++ b/t/templates/custom/view
@@ -0,0 +1,5 @@
+# Begin object list
+[% FOR obj = objects %]
+- [% obj.name %]
+[% END %]
+# End object list