[Maypole] Trying to build new model class
Andrew Findlay
andrew.findlay@skills-1st.co.uk
Fri, 7 May 2004 10:33:37 +0100
I am trying to build a new Model class so that I can work on LDAP data
with Maypole. This is turning out to be very frustrating!
I started by copying Maypole/Model/CDBI.pm and removing everything
that looked specific to DBI. This became Dir/Model.pm
I also copied Class/DBI/Loader/Generic.pm to Dir/Loader/Generic.pm
The only change to that so far is the module name.
Class/DBI/Loader/mysql.pm was copied to Dir/Loader/LDAP.pm and
modified. So far, this just removes the DBI stuff, but it should end
containing the LDAP connection code (calls to Net::LDAP). It currently
has a couple of 'table' names wired in for testing.
I override some parts of the config hash in the main application
class, to force Maypole to use Dir::Model rather than
Maypole::Model::CDBI. I found that I had to specify
view => "Maypole::View::TT" here too, which seems wrong.
Anyway, having done all that I have run up against a problem that I am
having great trouble with. Running the main class under Maypole::CLI
for tests, I get this error:
Can't call method "_table2class" on an undefined value at Dir/Model.pm line 129, <DATA> line 225.
Dir::Model::class_of('Dir::Model','Dir=HASH(0x8934eec)','dir') called at /usr/lib/perl5/site_perl/5.8.0/Maypole.pm line 65
Maypole::handler_guts('Dir=HASH(0x8934eec)') called at /usr/lib/perl5/site_perl/5.8.0/Maypole.pm line 57
Maypole::handler('Dir','Dir') called at /usr/lib/perl5/site_perl/5.8.0/Maypole.pm line 23
Maypole::__ANON__[/usr/lib/perl5/site_perl/5.8.0/Maypole.pm:23]('Dir') called at t3 line 9
The offending line is in class_of:
sub class_of {
my ($self, $r, $table) = @_;
return $r->config->{loader}->_table2class($table);
}
Obviously the loader stuff should have been filled in during the setup
phase, but I cannot see where.
I append copies of the relevant files: can anyone suggest what I might
have done wrong?
Thanks
Andrew
--
-----------------------------------------------------------------------
| From Andrew Findlay, Skills 1st Ltd |
| Consultant in large-scale systems, networks, and directory services |
| http://www.skills-1st.co.uk/ +44 1628 782565 |
-----------------------------------------------------------------------
Dir.pm:
=======
package Dir;
use base 'Apache::MVC';
# Override the model class to avoid getting Maypole::Model::CDBI
sub config {
my $h = {
model => "Dir::Model",
tables => ["people", "groups"],
view => "Maypole::View::TT", ## Should be the default!
};
return $h;
}
Dir->setup("XXsomeLDAPstuffXX", "YYuserYY", "ZZpasswdZZ");
Dir->config->{uri_base} = "http://brick-172-16-91-128/dir/";
Dir->config->{rows_per_page} = 10;
Dir->config->{display_tables} = [qw[people]];
1;
package Dir::People;
sub column_names {
(shift->SUPER::column_names(), cn => "Name")
}
sub display_columns {
("cn", "sn", "uid");
}
1;
-----------------------------------------------------------------------
Dir/Model.pm:
=============
package Dir::Model;
use base qw(Maypole::Model::Base Dir::Loader::LDAP);
use Lingua::EN::Inflect::Number qw(to_PL);
use CGI::Untaint;
use Dir::Loader;
use Dir::Loader::LDAP;
use strict;
=head1 NAME
Dir::Model - Model class based on Class::DBI
=head1 DESCRIPTION
This is a master model class which uses C<Net::LDAP> to do all the hard
work of fetching rows and representing them as objects.
=cut
sub related {
my ($self, $r) = @_;
# Has-many methods; XXX this is a hack
map {to_PL($_)}
grep { exists $r->{config}{ok_tables}{$_} }
map {$_->table}
keys %{shift->__hasa_list || {}}
}
sub do_edit :Exported {
my ($self, $r) = @_;
my $h = CGI::Untaint->new(%{$r->{params}});
my ($obj) = @{$r->objects || []};
if ($obj) {
# We have something to edit
$obj->update_from_cgi($h);
} else {
$obj = $self->create_from_cgi($h);
}
if (my %errors = $obj->cgi_update_errors) {
# Set it up as it was:
$r->{template_args}{cgi_params} = $r->{params};
$r->{template_args}{errors} = \%errors;
$r->{template} = "edit";
} else {
$r->{template} = "view";
}
$r->objects([ $obj ]);
}
sub delete :Exported {
return shift->SUPER::delete(@_) if caller ne "Maypole::Model::Base";
my ($self, $r) = @_;
$_->SUPER::delete for @{ $r->objects || [] };
$r->objects([ $self->retrieve_all ]);
$r->{template} = "list";
$self->list($r);
}
sub adopt {
my ($self, $child) = @_;
# Null so far...
}
sub search :Exported {
return shift->SUPER::search(@_) if caller ne "Maypole::Model::Base";
# A real CDBI search.
my ($self, $r) = @_;
my %fields = map {$_ => 1 } $self->columns;
my $oper = "like"; # For now
my %params = %{$r->{params}};
my %values = map { $_ => {$oper, $params{$_} } }
grep { $params{$_} and $fields{$_} } keys %params;
$r->template("list");
if (!%values) { return $self->list($r) }
my $order = $self->order($r);
$self = $self->do_pager($r);
$r->objects([ $self->search_where(\%values),
($order ? { order => $order } : ())
]);
$r->{template_args}{search} = 1;
}
sub do_pager {
my ($self, $r) = @_;
if ( my $rows = $r->config->{rows_per_page}) {
return $r->{template_args}{pager} = $self->pager($rows, $r->query->{page});
} else { return $self }
}
sub order {
my ($self, $r) = @_;
my $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;
}
sub list :Exported {
my ($self, $r) = @_;
my $order = $self->order($r);
$self = $self->do_pager($r);
if ($order) {
$r->objects([ $self->retrieve_all_sorted_by( $order )]);
} else {
$r->objects([ $self->retrieve_all ]);
}
}
sub setup_database {
my ($self, $config, $namespace, $dsn, $u, $p) = @_;
$config->{dsn} = $dsn;
$config->{loader} = Dir::Loader->new(
namespace => $namespace,
dsn => $dsn,
user => $u,
password => $p,
);
$config->{classes} = [ $config->{loader}->classes ];
$config->{tables} = [ $config->{loader}->tables ];
}
sub class_of {
my ($self, $r, $table) = @_;
return $r->config->{loader}->_table2class($table);
}
sub view :Exported { }
1;
-----------------------------------------------------------------------
Dir/Loader.pm:
==============
package Dir::Loader;
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
sub new {
my($class, %args) = @_;
my $impl = "Dir::Loader::LDAP";
eval qq/use $impl/;
return $impl->new(%args);
}
1;
-----------------------------------------------------------------------
Dir/Loader/Generic.pm:
======================
package Dir::Loader::Generic;
# Derived from Class::DBI::Loader::Generic
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
use Carp ();
require Class::Accessor;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(_datasource _namespace));
sub _croak { require Carp; Carp::croak(@_); }
sub new {
my($class, %args) = @_;
my $self = bless {
_datasource => [ $args{dsn}, $args{user}, $args{password}, $args{options}],
_namespace => $args{namespace},
CLASSES => {},
}, $class;
$self->_load_classes;
$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} || "";
$namespace =~ s/(.*)::$/$1/;
my $subclass = $table;
$subclass =~ s/_(\w)/ucfirst($1)/eg;
my $class = $namespace ? "$namespace\::". ucfirst($subclass) : ucfirst($subclass);
}
1;
__END__
=head1 NAME
Dir::Loader::Generic - generic Class Loader implementation.
=head1 SYNOPSIS
ABSTRACT CLASS
=head1 DESCRIPTION
Derived from
Class::DBI::Loader::Generic - generic Class::DBI::Loader implementation.
please see L<Class::DBI::Loader>
=head1 AUTHOR
Class::DBI::Loader::Generic by IKEBE Tomohiro E<lt>ikebe@edge.co.jpE<gt>
This derivation by Andrew Findlay E<lt>andrew.findlay@skills-1st.co.ukE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<Class::DBI::Loader>
=cut
-----------------------------------------------------------------------
Dir/Loader/LDAP.pm:
===================
package Dir::Loader::LDAP;
# Derived from Class::DBI::Loader::mysql;
use strict;
use Carp ();
require Net::LDAP;
require Dir::Loader::Generic;
use base qw(Dir::Loader::Generic);
use vars qw($VERSION);
$VERSION = '0.01';
sub _croak { require Carp; Carp::croak(@_); }
sub _load_classes {
my $self = shift;
my @tables = ("people", "groups");
foreach my $table(@tables) {
my $class = $self->_table2class($table);
no strict 'refs';
@{"$class\::ISA"} = qw(Net::LDAP);
$self->{CLASSES}->{$table} = $class;
}
}
1;
__END__
=head1 NAME
Dir::Loader::LDAP - Class Loader for LDAP data source
=head1 SYNOPSIS
use Dir::Loader;
# $loader is a Dir::Loader::LDAP
my $loader = Dir::Loader::LDAP->new(
dsn => "dbi:mysql:dbname",
user => "root",
password => "",
namespace => "Data",
);
my $class = $loader->find_class('film'); # $class => Data::Film
my $obj = $class->retrieve(1);
=head1 DESCRIPTION
Derived from
Class::DBI::Loader::mysql - Class::DBI::Loader mysql implementation.
please see L<Class::DBI::Loader>
=head1 AUTHOR
Class::DBI::Loader::mysql by IKEBE Tomohiro E<lt>ikebe@edge.co.jpE<gt>
This derivation by Andrew Findlay E<lt>andrew.findlay@skills-1st.co.ukE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<Class::DBI::Loader>
=cut
-----------------------------------------------------------------------