I've been digging into Maypole a bit in order to customise some aspects.
One thing I want to do is to improve the text generation. At present,
displayable column and table names are generated in many different
places in Maypole and in consequence different strings are displayed on
different pages of generated websites for the same entity. Also, the
string generation is not easily customised (for example to another
language).
As a first step I decided to identify all the places this happened and
work out a way of using customised methods to set the strings. This has
taken a lot longer than I thought it would and I'm pretty overwhelmed by
the number of twisty little classes, methods and attributes now. So I've
thrown something together. I'm sure there's better ways to do this and
would welcome feedback. Oh, this is all v1.7.
I've written an experimental model subclass, hacked into
Class::DBI::Loader because I couldn't see how to subclass it, and added
some code to my controller class to generate text for table and column
names, but I think it would be good if this could be factored back into
the underlying Maypole classes. There are some larger issues that I
think would also be worth discussing.
Displayable strings for table names are sometimes generated using
UNIVERSAL::moniker, inherited into the model from Class::DBI. This is a
bad idea. UNIVERSAL::moniker generates a displayable text string from a
class name. But Maypole generates the class name from a SQL table name
by discarding information! It is better to generate the displayable text
string from the SQL, just as Maypole does for column names. In other
places, Maypole just displays the SQL table name raw.
BTW, Maypole::View::Base says "use UNIVERSAL::moniker;" but never
actually makes use of it. The moniker for the template is actually
derived using the *model*->moniker method. So I believe the "use
UNIVERSAL::moniker;" should be deleted from Maypole::View::Base.
I've overridden the moniker and plural_moniker methods in my model for
now. In fact these should be in the underlying View class IMO; see below.
When I did that, I discovered another area that should be improved. At
present, the methods get called whenever the moniker is required. So
they get called twice in a CGI script (once as the value of the
classdata.moniker template variable and once as the name of the e.g.
brewery template variable). In a mod_perl environment, I suppose they
get called over and over again. It would be better if the moniker and
plural_moniker were calculated once and stored in the class data.
Then I discovered that table display names are not always generated in
this fashion. Sometimes they're displayed as raw SQL table names! I've
hacked round that by adding values for
config.name.your_table_name.singular
config.name.your_table_name.plural
in the model's adopt() method. This feels awful but at least it makes
the names available to the template.
So please feel free to shoot away and tell me how it can be done better!
On the more general questions I mentioned above, a basic principle of
software design, IMHO, is that text intended for display should be
separated from code, so it can be customised. This is a closely related
principle to that for using templates to separate web page design. We
might need to relax this, since Maypole gets some of its power from its
automatic string generation, but I think there should be a design goal
that developers can refer to.
As well as the name strings discussed above, there's also hard-coded
text for display in several classes; these are mainly error messages.
But there should be some provision for an indirection mechanism to
change the text either for local support reasons or to use another
language. It might be worth considering a coderef hook to permit
changing behaviour in such cases.
Cheers, Dave
*********************
controller class
*********************
package QD1;
use base 'CGI::Maypole';
use Class::DBI::Loader::Relationship;
sub debug { 1 }
# Allow template filenames to have an extension like .tt
#
sub template
{
my $r = shift;
my $t = $r->_template_accessor(@_);
my $ext = $r->{config}->{template_extension};
return $ext ? $t . $ext : $t;
}
QD1->config->{model} = "my_Model";
QD1->config->{loader_class} = "my_CDBI_Loader";
# This is the QD1 application. This is the path to the database.
QD1->setup("dbi:mysql:q_d_1");
# This is the root of the web space (MUST have trailing slash).
QD1->config->{uri_base} = "http://localhost/cgi-bin/qd1.cgi/";
# This is the full path of the template files corresponding to the web space
QD1->config->{template_root} = '/var/www/qd1/';
# and the filename extension for template files
QD1->config->{template_extension} = '.tt';
QD1->config->{rows_per_page} = 10;
1;
*********************
model class
*********************
use strict;
use warnings;
package my_Model;
use base 'Maypole::Model::CDBI';
use Lingua::EN::Inflect::Number qw(to_S to_PL);
my $config_cache; # cache laoded by setup_database() for use by adopt()
1;
# Convert SQL table or column names to Displayable Names
# Convert everything except alphanumeric to a space and titlecase
# fragments.
#
sub _sql2displayable
{
my $string = join(' ', map { ucfirst } split(/[^a-zA-Z0-9]/, shift));
$string =~ s/\s+/ /g; # compress multiple spaces
$string =~ s/^\s+//; # delete leading spaces
$string =~ s/\s+$//; # delete trailing spaces
return $string;
}
# Return list of columns to be displayed, in desired order
# TODO Modify to use order from DDL
#
sub display_columns
{
my $self = shift;
return sort $self->columns;
}
# Return hash from column name to displayable name
# TODO Deal with foreign keys - change name and make relationship
#
sub column_names
{
my $class = shift;
return map { $_ => _sql2displayable $_ } $class->columns;
}
sub moniker
{
my $class = shift;
my $table = $class->_table;
my $moniker = _sql2displayable(to_S($table));
return $moniker;
}
sub plural_moniker
{
my $class = shift;
my $table = $class->_table;
my $moniker = _sql2displayable(to_PL($table));
return $moniker;
}
sub setup_database
{
my ($self, $config, $namespace, $dsn, $u, $p, $opts) = @_;
$config_cache = $config; # remember config for use by adopt()
$config->{dsn} = $dsn;
my $loader = $config->{loader_class};
if ($loader)
{
eval "use $loader";
die $@ if $@;
}
else
{
$loader = 'Class::DBI::Loader';
}
$config->{loader} = $loader->new(
namespace => $namespace,
dsn => $dsn,
user => $u,
password => $p,
options => $opts,
);
$config->{classes} = [ $config->{loader}->classes ];
$config->{tables} = [ $config->{loader}->tables ];
}
# Don't know exactly what adopt() is for, but I'm using it to
# add the displayable names of the tables to the config so the
# templates can access them.
#
sub adopt
{
my ($self, $subclass) = @_;
$config_cache->{name}->{$subclass->_table} =
{
singular => $subclass->moniker,
plural => $subclass->plural_moniker,
};
}
*********************
loader class
*********************
package my_CDBI_Loader;
# Based on Class::DBI::Loader with some code from Class::DBI::Autoloader
# I combined Class::DBI::Loader and Class::DBI::Loader::Generic to make
# my hack simpler. I don't know why they are separate.
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
use Carp ();
require Class::Accessor;
use Lingua::EN::Inflect::Number 'to_S';
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(_datasource _namespace));
1;
sub _croak { require Carp; Carp::croak(@_); }
sub new {
my($class, %args) = @_;
my $dsn = $args{dsn};
my($driver) = $dsn =~ m/^dbi:(\w*?)(?:\((.*?)\))?:/i;
# my $impl = "Class::DBI::Loader::". $driver;# djh
my $impl = __PACKAGE__ .'::'. $driver; # djh
eval qq/use $impl/;
# return $impl->new(%args); # djh
#} # djh
# # djh
# HERE'S THE SEAMLESS JOIN WITH Generic! # djh
# # djh
#sub new2 { # djh
# my($class, %args) = @_; # djh
my $namespace = $args{namespace} || ''; # djh
$namespace =~ s/(.*)::$/$1/; # djh
my $self = bless {
_datasource => [ $args{dsn}, $args{user}, $args{password},
$args{options}],
_namespace => $namespace, # djh
CLASSES => {},
}, $class;
$impl->_load_classes($self); # djh
return $self;
}
sub _load_classes {
_croak('ABSTRACT METHOD');
}
sub find_class {
my($self,$table) = @_;
return $self->{CLASSES}->{$table};
}
sub classes {
my $self = shift;
return sort values %{$self->{CLASSES}};
}
sub tables {
my $self = shift;
return sort keys %{$self->{CLASSES}};
}
sub _table2class {
my($self, $table) = @_;
my $namespace = $self->{_namespace}; # djh
my $class = join('', map { ucfirst } split(/[^a-zA-Z0-9]/,
to_S($table))); #djh
$class = "$namespace\::$class" if $namespace; # djh
return $class; # djh
}
*********************
loader subclass for mysql
*********************
package my_CDBI_Loader::mysql;
# Based on Class::DBI::Loader
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
use Carp ();
use DBI;
require Class::DBI::mysql;
#require Class::DBI::Loader::Generic; # djh
#use base qw(Class::DBI::Loader::Generic); # djh
sub _croak { require Carp; Carp::croak(@_); }
sub _load_classes {
my ($impl_class, $self) = @_; # djh
my $dbh = DBI->connect(@{$self->_datasource})
or _croak($DBI::errstr);
foreach my $table($dbh->tables) {
my $quoter = $dbh->get_info(29);
$table =~ s/$quoter//g;
my $class = $self->_table2class($table);
no strict 'refs';
@{"$class\::ISA"} = qw(Class::DBI::mysql);
$class->set_db(Main => @{$self->_datasource});
$class->set_up_table($table);
$self->{CLASSES}->{$table} = $class;
}
$dbh->disconnect;
}
1;
***************************
_______________________________________________
maypole mailing list
maypole at lists.netthink.co.uk
http://lists.netthink.co.uk/listinfo/maypole
This archive was generated by hypermail 2.1.3 : Thu Feb 24 2005 - 22:25:56 GMT